line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Logfile::Access; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# $Id: Access.pm,v 1.30 2004/10/25 18:58:12 root Exp $ |
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
24451
|
use 5.008; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
43
|
|
6
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
38
|
|
7
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
34
|
|
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
2289
|
use URI; |
|
1
|
|
|
|
|
19531
|
|
|
1
|
|
|
|
|
33
|
|
10
|
1
|
|
|
1
|
|
13
|
use URI::Escape; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
82
|
|
11
|
1
|
|
|
1
|
|
1002
|
use Locale::Country; |
|
1
|
|
|
|
|
56358
|
|
|
1
|
|
|
|
|
210
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
require Exporter; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# Items to export into callers namespace by default. Note: do not export |
18
|
|
|
|
|
|
|
# names by default without a very good reason. Use EXPORT_OK instead. |
19
|
|
|
|
|
|
|
# Do not simply export all your public functions/methods/constants. |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# This allows declaration use Logfile::Access ':all'; |
22
|
|
|
|
|
|
|
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK |
23
|
|
|
|
|
|
|
# will save memory. |
24
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( 'all' => [ qw( |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
) ] ); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
our @EXPORT = qw( |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
our $VERSION = '1.30'; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# Preloaded methods go here. |
37
|
|
|
|
|
|
|
|
38
|
1
|
|
|
1
|
|
11
|
use constant MIME_TYPE_CONFIG_FILENAME => "/etc/httpd/conf/mime.types"; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
483
|
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub new |
41
|
|
|
|
|
|
|
{ |
42
|
|
|
|
|
|
|
|
43
|
1
|
|
|
1
|
0
|
13
|
my $self = {}; |
44
|
1
|
|
|
|
|
3
|
my $loop = 1; |
45
|
|
|
|
|
|
|
|
46
|
1
|
|
|
|
|
3
|
my @column; |
47
|
1
|
50
|
|
|
|
8
|
if (scalar @_ > 1) |
48
|
|
|
|
|
|
|
{ |
49
|
0
|
|
|
|
|
0
|
foreach my $key (@column) |
50
|
|
|
|
|
|
|
{ |
51
|
0
|
|
|
|
|
0
|
$self->{$key} = $_[$loop++]; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
} |
54
|
1
|
|
|
|
|
33
|
bless($self); |
55
|
1
|
|
|
|
|
6
|
$self->load_mime_types; |
56
|
1
|
|
|
|
|
5
|
return $self; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
my %mime_type; |
60
|
|
|
|
|
|
|
sub load_mime_types |
61
|
|
|
|
|
|
|
{ |
62
|
1
|
50
|
|
1
|
0
|
6
|
return if %mime_type; |
63
|
1
|
50
|
|
|
|
34
|
if (open (IN, MIME_TYPE_CONFIG_FILENAME)) |
64
|
|
|
|
|
|
|
{ |
65
|
0
|
|
|
|
|
0
|
while () |
66
|
|
|
|
|
|
|
{ |
67
|
0
|
0
|
|
|
|
0
|
next if $_ =~ /^ *\#/; |
68
|
0
|
|
|
|
|
0
|
$_ =~ s/\n|\r//g; |
69
|
0
|
|
|
|
|
0
|
my @data = split (/( |\t)+/, $_); |
70
|
0
|
|
|
|
|
0
|
my $mime_type = shift @data; |
71
|
0
|
|
|
|
|
0
|
foreach my $extension (@data) |
72
|
|
|
|
|
|
|
{ |
73
|
0
|
0
|
|
|
|
0
|
next if $extension !~ /\w/; |
74
|
0
|
|
|
|
|
0
|
$mime_type{$extension} = $mime_type; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} |
77
|
0
|
|
|
|
|
0
|
close IN; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
else |
80
|
|
|
|
|
|
|
{ |
81
|
1
|
|
|
|
|
61
|
warn "unable to open " . MIME_TYPE_CONFIG_FILENAME . "\n"; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
1
|
|
|
1
|
|
7
|
use constant REGEX_IP => q{(\S+)}; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
64
|
|
86
|
1
|
|
|
1
|
|
6
|
use constant REGEX_DATE => q{(\d{2})\/(\w{3})\/(\d{4})}; |
|
1
|
|
|
|
|
9
|
|
|
1
|
|
|
|
|
53
|
|
87
|
1
|
|
|
1
|
|
7
|
use constant REGEX_TIME => q{(\d{2}):(\d{2}):(\d{2})}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
56
|
|
88
|
1
|
|
|
1
|
|
5
|
use constant REGEX_OFFSET => q{([+\-]\d{4})}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
61
|
|
89
|
1
|
|
|
1
|
|
5
|
use constant REGEX_METHOD => q{(\S+)}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
90
|
1
|
|
|
1
|
|
5
|
use constant REGEX_OBJECT => q{([^ ]+)}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
91
|
1
|
|
|
1
|
|
14
|
use constant REGEX_PROTOCOL => q{(\w+\/[\d\.]+)}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
45
|
|
92
|
1
|
|
|
1
|
|
5
|
use constant REGEX_STATUS => q{(\d+|\-)}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
55
|
|
93
|
1
|
|
|
1
|
|
7
|
use constant REGEX_CONTENT_LENGTH => q{(\d+|\-)}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
48
|
|
94
|
1
|
|
|
1
|
|
5
|
use constant REGEX_HTTP_REFERER => q{([^"]+)}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
95
|
1
|
|
|
1
|
|
5
|
use constant REGEX_HTTP_USER_AGENT => q{([^"]+)}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
96
|
1
|
|
|
1
|
|
5
|
use constant REGEX_COOKIE => q{([^"]+)}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
7704
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub parse_iis |
99
|
|
|
|
|
|
|
{ |
100
|
0
|
|
|
0
|
0
|
0
|
my $class = "parse"; |
101
|
0
|
|
|
|
|
0
|
my $self = shift; |
102
|
0
|
|
|
|
|
0
|
my $row = shift; |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
#1998-11-19 22:48:39 206.175.82.5 - 208.201.133.173 GET /global/images/navlineboards.gif - 200 540 324 157 HTTP/1.0 Mozilla/4.0+(compatible;+MSIE+4.01;+Windows+95) USERID=CustomerA;+IMPID=01234 http://www.loganalyzer.net |
105
|
0
|
0
|
|
|
|
0
|
if ($row =~ /^(\d{4})-(\d{2})-(\d{2}) @{[REGEX_TIME]} @{[REGEX_IP]} @{[REGEX_IP]} @{[REGEX_METHOD]} @{[REGEX_OBJECT]} (\S+) @{[REGEX_STATUS]} (\d+) (\d+) (\d+) (\d+) @{[REGEX_PROTOCOL]} @{[REGEX_HTTP_USER_AGENT]} @{[REGEX_COOKIE]} @{[REGEX_HTTP_REFERER]} *$/) |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
106
|
|
|
|
|
|
|
{ |
107
|
0
|
|
|
|
|
0
|
$self->{"date"} = join("/", $1, $2, $3); |
108
|
0
|
|
|
|
|
0
|
$self->{"year"} = $1; |
109
|
0
|
|
|
|
|
0
|
$self->{"month"} = $2; |
110
|
0
|
|
|
|
|
0
|
$self->{"mday"} = $3; |
111
|
|
|
|
|
|
|
|
112
|
0
|
|
|
|
|
0
|
$self->{"time"} = join(":", $4, $5, $6); |
113
|
0
|
|
|
|
|
0
|
$self->{"hour"} = $4; |
114
|
0
|
|
|
|
|
0
|
$self->{"minute"} = $5; |
115
|
0
|
|
|
|
|
0
|
$self->{"second"} = $6; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
else |
118
|
|
|
|
|
|
|
{ |
119
|
0
|
|
|
|
|
0
|
return 0; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
0
|
return $self->{$class} |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub parse |
126
|
|
|
|
|
|
|
{ |
127
|
2
|
|
|
2
|
0
|
12
|
my $class = "parse"; |
128
|
2
|
|
|
|
|
5
|
my $self = shift; |
129
|
2
|
|
|
|
|
4
|
my $row = shift; |
130
|
|
|
|
|
|
|
|
131
|
2
|
|
|
|
|
11
|
$row =~ s/\n|\r//g; |
132
|
|
|
|
|
|
|
|
133
|
2
|
50
|
33
|
|
|
5
|
if ( |
134
|
2
|
|
|
|
|
7
|
($row =~ /^@{[REGEX_IP]} (\S+) (\S+) \[@{[REGEX_DATE]}:@{[REGEX_TIME]} @{[REGEX_OFFSET]}\] \"@{[REGEX_METHOD]} @{[REGEX_OBJECT]} @{[REGEX_PROTOCOL]}\" @{[REGEX_STATUS]} @{[REGEX_CONTENT_LENGTH]} *$/) |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
123
|
|
135
|
|
|
|
|
|
|
|| |
136
|
2
|
|
|
|
|
6
|
($row =~ /^@{[REGEX_IP]} (\S+) (\S+) \[@{[REGEX_DATE]}:@{[REGEX_TIME]} @{[REGEX_OFFSET]}\] \"@{[REGEX_METHOD]} @{[REGEX_OBJECT]} @{[REGEX_PROTOCOL]}\" @{[REGEX_STATUS]} @{[REGEX_CONTENT_LENGTH]} \"?@{[REGEX_HTTP_REFERER]}\"? \"?@{[REGEX_HTTP_USER_AGENT]}\"?$/) |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
135
|
|
137
|
|
|
|
|
|
|
) |
138
|
|
|
|
|
|
|
{ |
139
|
2
|
|
|
|
|
19
|
$self->{"remote_host"} = $1; |
140
|
2
|
|
|
|
|
16
|
$self->{"logname"} = $2; |
141
|
2
|
|
|
|
|
8
|
$self->{"user"} = $3; |
142
|
2
|
|
|
|
|
14
|
$self->{"date"} = join("/", $4, $5, $6); |
143
|
2
|
|
|
|
|
6
|
$self->{"mday"} = $4; |
144
|
2
|
|
|
|
|
7
|
$self->{"month"} = $5; |
145
|
2
|
|
|
|
|
5
|
$self->{"year"} = $6; |
146
|
2
|
|
|
|
|
13
|
$self->{"time"} = join(":", $7, $8, $9); |
147
|
2
|
|
|
|
|
5
|
$self->{"hour"} = $7; |
148
|
2
|
|
|
|
|
6
|
$self->{"minute"} = $8; |
149
|
2
|
|
|
|
|
5
|
$self->{"second"} = $9; |
150
|
2
|
|
|
|
|
11
|
$self->{"offset"} = $10; |
151
|
2
|
|
|
|
|
17
|
$self->{"method"} = $11; |
152
|
2
|
|
|
|
|
7
|
$self->{"object"} = $12; |
153
|
2
|
|
|
|
|
5
|
$self->{"protocol"} = $13; |
154
|
2
|
|
|
|
|
7
|
$self->{"response_code"} = $14; |
155
|
2
|
|
|
|
|
8
|
$self->{"content_length"} = $15; |
156
|
2
|
|
|
|
|
4
|
$self->{"http_referer"} = $16; |
157
|
2
|
|
|
|
|
6
|
$self->{"http_user_agent"} = $17; |
158
|
2
|
|
|
|
|
16
|
return 1; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
else |
161
|
|
|
|
|
|
|
{ |
162
|
|
|
|
|
|
|
#die $row; |
163
|
0
|
|
|
|
|
0
|
return 0; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
#if (@_) {$self->{$class} = shift} |
166
|
|
|
|
|
|
|
#return $self->{$class} |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub print |
170
|
|
|
|
|
|
|
{ |
171
|
0
|
|
|
0
|
0
|
0
|
my $class = "print"; |
172
|
0
|
|
|
|
|
0
|
my $self = shift; |
173
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
0
|
my $datetime = "[" . $self->{"date"} . ":" . $self->{"time"} . " " . $self->{"offset"} . "]"; |
175
|
0
|
|
|
|
|
0
|
my $object = "\"" . join(" ", $self->{"method"}, $self->{"object"}, $self->{"protocol"}) . "\""; |
176
|
0
|
|
|
|
|
0
|
print join(" ", $self->{"remote_host"}, $self->{"logname"}, $self->{"user"}, $datetime, $object, $self->{"response_code"}, $self->{"content_length"}, "\n"); |
177
|
|
|
|
|
|
|
|
178
|
0
|
0
|
|
|
|
0
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
179
|
0
|
|
|
|
|
0
|
return $self->{$class} |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
## REMOTE HOST RELATED FUNCTIONS |
183
|
|
|
|
|
|
|
sub class_a |
184
|
|
|
|
|
|
|
{ |
185
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
186
|
|
|
|
|
|
|
|
187
|
1
|
|
|
|
|
7
|
my $host = $self->remote_host; |
188
|
1
|
50
|
|
|
|
12
|
if ($host =~ /^(\d{1,3}\.)(\d{1,3}\.){2}(\d+)(:\d+)?$/) |
189
|
|
|
|
|
|
|
{ |
190
|
1
|
|
|
|
|
7
|
return $1; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub class_b |
195
|
|
|
|
|
|
|
{ |
196
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
197
|
|
|
|
|
|
|
|
198
|
1
|
|
|
|
|
3
|
my $host = $self->remote_host; |
199
|
1
|
50
|
|
|
|
12
|
if ($host =~ /^((\d{1,3}\.){2})(\d{1,3}\.)(\d+)(:\d+)?$/) |
200
|
|
|
|
|
|
|
{ |
201
|
1
|
|
|
|
|
8
|
return $1; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub class_c |
206
|
|
|
|
|
|
|
{ |
207
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
208
|
|
|
|
|
|
|
|
209
|
1
|
|
|
|
|
4
|
my $host = $self->remote_host; |
210
|
1
|
50
|
|
|
|
14
|
if ($host =~ /^((\d{1,3}\.){3})(\d+)(:\d+)?$/) |
211
|
|
|
|
|
|
|
{ |
212
|
1
|
|
|
|
|
7
|
return $1; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub tld |
217
|
|
|
|
|
|
|
{ |
218
|
4
|
|
|
4
|
0
|
12
|
my $class = "tld"; |
219
|
4
|
|
|
|
|
7
|
my $self = shift; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
|
222
|
4
|
50
|
|
|
|
19
|
if (my $host = $self->{"remote_host"}) |
223
|
|
|
|
|
|
|
{ |
224
|
4
|
100
|
|
|
|
39
|
if ($host =~ /\.([a-z]{2,5})$/i) |
225
|
|
|
|
|
|
|
{ |
226
|
2
|
|
|
|
|
4
|
my $tld = $1; |
227
|
2
|
|
|
|
|
23
|
$tld =~ tr/A-Z/a-z/; |
228
|
2
|
|
|
|
|
10
|
return $tld; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub country_name |
234
|
|
|
|
|
|
|
{ |
235
|
2
|
|
|
2
|
0
|
5
|
my $class = "country_name"; |
236
|
2
|
|
|
|
|
4
|
my $self = shift; |
237
|
|
|
|
|
|
|
|
238
|
2
|
|
|
|
|
6
|
my $host = $self->{"remote_host"}; |
239
|
2
|
|
|
|
|
5
|
my $tld = $self->tld; |
240
|
2
|
|
|
|
|
13
|
$self->{$class} = code2country($tld); |
241
|
2
|
|
|
|
|
121
|
return $self->{$class}; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub domain |
245
|
|
|
|
|
|
|
{ |
246
|
2
|
|
|
2
|
0
|
4
|
my $self = shift; |
247
|
|
|
|
|
|
|
|
248
|
2
|
|
|
|
|
8
|
my $host = $self->remote_host; |
249
|
2
|
|
|
|
|
5
|
$host =~ s/:\d+$//; |
250
|
|
|
|
|
|
|
|
251
|
2
|
100
|
|
|
|
17
|
return if $host =~ /\.\d+(:\d+)?$/; |
252
|
|
|
|
|
|
|
do |
253
|
1
|
|
|
|
|
2
|
{ |
254
|
2
|
50
|
|
|
|
21
|
$host =~ s/^([^\.]*\.)// || return $host; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
until $host =~ /^[\w\-]+\.[\w]+$/; |
257
|
1
|
|
|
|
|
5
|
return $host; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub remote_port |
261
|
|
|
|
|
|
|
{ |
262
|
|
|
|
|
|
|
## THIS IS A USELESS PIECE OF CODE, REMOTE_HOSTS NEVER HAVE PORT NUMBER |
263
|
0
|
|
|
0
|
0
|
0
|
my $class = "remote_port"; |
264
|
0
|
|
|
|
|
0
|
my $self = shift; |
265
|
|
|
|
|
|
|
|
266
|
0
|
|
|
|
|
0
|
my $host = $self->{"remote_host"}; |
267
|
0
|
0
|
|
|
|
0
|
return $1 if $host =~ /:(\d+)\b$/; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
sub remote_host |
271
|
|
|
|
|
|
|
{ |
272
|
7
|
|
|
7
|
1
|
11
|
my $class = "remote_host"; |
273
|
7
|
|
|
|
|
11
|
my $self = shift; |
274
|
7
|
50
|
|
|
|
20
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
275
|
7
|
|
|
|
|
26
|
return $self->{$class} |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub logname |
279
|
|
|
|
|
|
|
{ |
280
|
2
|
|
|
2
|
0
|
5
|
my $class = "logname"; |
281
|
2
|
|
|
|
|
5
|
my $self = shift; |
282
|
2
|
50
|
|
|
|
7
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
283
|
2
|
|
|
|
|
10
|
return $self->{$class} |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub user |
287
|
|
|
|
|
|
|
{ |
288
|
2
|
|
|
2
|
0
|
4
|
my $class = "user"; |
289
|
2
|
|
|
|
|
4
|
my $self = shift; |
290
|
2
|
50
|
|
|
|
8
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
291
|
2
|
|
|
|
|
10
|
return $self->{$class} |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub date |
295
|
|
|
|
|
|
|
{ |
296
|
2
|
|
|
2
|
1
|
5
|
my $class = "date"; |
297
|
2
|
|
|
|
|
12
|
my $self = shift; |
298
|
2
|
50
|
|
|
|
8
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
299
|
2
|
|
|
|
|
11
|
return $self->{$class} |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub fix_mday |
303
|
|
|
|
|
|
|
{ |
304
|
|
|
|
|
|
|
## BUG: DOES NOT SUPPORT LEAP YEAR |
305
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
306
|
0
|
|
|
|
|
0
|
my $mday = shift; |
307
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
0
|
$mday = int($mday); |
309
|
0
|
0
|
|
|
|
0
|
$mday = 1 if $mday < 1; |
310
|
0
|
0
|
|
|
|
0
|
$mday = 31 if $mday > 31; |
311
|
|
|
|
|
|
|
|
312
|
0
|
0
|
|
|
|
0
|
if ($self->{"month"} =~ /^(jan|mar|may|jul|aug|oct|dec)$/i) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
313
|
|
|
|
|
|
|
{ |
314
|
0
|
0
|
|
|
|
0
|
$mday = 31 if $mday > 31; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
elsif ($self->{"month"} =~ /^(apr|jun|sep|nov)$/i) |
317
|
|
|
|
|
|
|
{ |
318
|
0
|
0
|
|
|
|
0
|
$mday = 30 if $mday > 30; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
elsif ($self->{"month"} =~ /^(feb)$/i) |
321
|
|
|
|
|
|
|
{ |
322
|
0
|
0
|
|
|
|
0
|
$mday = 29 if $mday > 29; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
0
|
|
|
|
|
0
|
return $mday; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
sub mday |
329
|
|
|
|
|
|
|
{ |
330
|
2
|
|
|
2
|
0
|
5
|
my $class = "mday"; |
331
|
2
|
|
|
|
|
4
|
my $self = shift; |
332
|
2
|
50
|
|
|
|
8
|
if (@_) |
333
|
|
|
|
|
|
|
{ |
334
|
0
|
|
|
|
|
0
|
$self->{$class} = shift; |
335
|
0
|
|
|
|
|
0
|
$self->{$class} = fix_mday($self, $self->{$class}); |
336
|
0
|
|
|
|
|
0
|
$self->{"date"} = sprintf("%2.2d/%3.3s/%4.4d", $self->{"mday"}, $self->{"month"}, $self->{"year"}); |
337
|
|
|
|
|
|
|
} |
338
|
2
|
|
|
|
|
11
|
return $self->{$class} |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub fix_month |
342
|
|
|
|
|
|
|
{ |
343
|
0
|
|
|
0
|
0
|
0
|
my $month = shift; |
344
|
|
|
|
|
|
|
|
345
|
0
|
0
|
|
|
|
0
|
if ($month =~ /^\d+$/) |
346
|
|
|
|
|
|
|
{ |
347
|
0
|
|
|
|
|
0
|
$month %= 12; |
348
|
0
|
0
|
|
|
|
0
|
$month = 12 if $month == 0; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
0
|
0
|
|
|
|
0
|
if ($month =~ /^(jan|0?1)$/i) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
352
|
|
|
|
|
|
|
{ |
353
|
0
|
|
|
|
|
0
|
$month = "Jan"; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
elsif ($month =~ /^(feb|0?2)$/i) |
356
|
|
|
|
|
|
|
{ |
357
|
0
|
|
|
|
|
0
|
$month = "Feb"; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
elsif ($month =~ /^(mar|0?3)$/i) |
360
|
|
|
|
|
|
|
{ |
361
|
0
|
|
|
|
|
0
|
$month = "Mar"; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
elsif ($month =~ /^(apr|0?4)$/i) |
364
|
|
|
|
|
|
|
{ |
365
|
0
|
|
|
|
|
0
|
$month = "Apr"; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
elsif ($month =~ /^(may|0?5)$/i) |
368
|
|
|
|
|
|
|
{ |
369
|
0
|
|
|
|
|
0
|
$month = "May"; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
elsif ($month =~ /^(jun|0?6)$/i) |
372
|
|
|
|
|
|
|
{ |
373
|
0
|
|
|
|
|
0
|
$month = "Jun"; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
elsif ($month =~ /^(jul|0?7)$/i) |
376
|
|
|
|
|
|
|
{ |
377
|
0
|
|
|
|
|
0
|
$month = "Jul"; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
elsif ($month =~ /^(aug|0?8)$/i) |
380
|
|
|
|
|
|
|
{ |
381
|
0
|
|
|
|
|
0
|
$month = "Aug"; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
elsif ($month =~ /^(sep|0?9)$/i) |
384
|
|
|
|
|
|
|
{ |
385
|
0
|
|
|
|
|
0
|
$month = "Sep"; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
elsif ($month =~ /^(oct|10)$/i) |
388
|
|
|
|
|
|
|
{ |
389
|
0
|
|
|
|
|
0
|
$month = "Oct"; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
elsif ($month =~ /^(nov|11)$/i) |
392
|
|
|
|
|
|
|
{ |
393
|
0
|
|
|
|
|
0
|
$month = "Nov"; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
elsif ($month =~ /^(dec|12)$/i) |
396
|
|
|
|
|
|
|
{ |
397
|
0
|
|
|
|
|
0
|
$month = "Dec"; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
sub month |
402
|
|
|
|
|
|
|
{ |
403
|
2
|
|
|
2
|
0
|
5
|
my $class = "month"; |
404
|
2
|
|
|
|
|
4
|
my $self = shift; |
405
|
2
|
50
|
|
|
|
7
|
if (@_) |
406
|
|
|
|
|
|
|
{ |
407
|
0
|
|
|
|
|
0
|
$self->{$class} = shift; |
408
|
0
|
|
|
|
|
0
|
$self->{$class} = fix_month($self->{$class}); |
409
|
0
|
|
|
|
|
0
|
$self->{"date"} = sprintf("%2.2d/%3.3s/%4.4d", $self->{"mday"}, $self->{"month"}, $self->{"year"}); |
410
|
|
|
|
|
|
|
} |
411
|
2
|
|
|
|
|
10
|
return $self->{$class} |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
sub fix_year |
415
|
|
|
|
|
|
|
{ |
416
|
0
|
|
|
0
|
0
|
0
|
my $year = shift; |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
## CLEAN UP DATA |
419
|
0
|
|
|
|
|
0
|
$year =~ s/\D//g; |
420
|
0
|
|
|
|
|
0
|
$year = int($year); |
421
|
0
|
|
|
|
|
0
|
$year =~ s/^(\d{4}).*$/$1/; |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
## ALLOW FOR SHORTCUTS |
424
|
0
|
0
|
0
|
|
|
0
|
$year = 1900 + $year if (($year >= 38) && ($year < 100)); |
425
|
0
|
0
|
0
|
|
|
0
|
$year = 2000 + $year if (($year >= 00) && ($year < 38)); |
426
|
|
|
|
|
|
|
|
427
|
0
|
|
|
|
|
0
|
$year = sprintf("%4.4d", $year); |
428
|
0
|
|
|
|
|
0
|
return $year; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
sub year |
432
|
|
|
|
|
|
|
{ |
433
|
2
|
|
|
2
|
0
|
5
|
my $class = "year"; |
434
|
2
|
|
|
|
|
4
|
my $self = shift; |
435
|
2
|
50
|
|
|
|
8
|
if (@_) |
436
|
|
|
|
|
|
|
{ |
437
|
0
|
|
|
|
|
0
|
$self->{$class} = shift; |
438
|
0
|
|
|
|
|
0
|
$self->{$class} = fix_year($self->{$class}); |
439
|
0
|
|
|
|
|
0
|
$self->{"date"} = sprintf("%2.2d/%3.3s/%4.4d", $self->{"mday"}, $self->{"month"}, $self->{"year"}); |
440
|
|
|
|
|
|
|
} |
441
|
2
|
|
|
|
|
11
|
return $self->{$class} |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub time |
445
|
|
|
|
|
|
|
{ |
446
|
2
|
|
|
2
|
1
|
3
|
my $class = "time"; |
447
|
2
|
|
|
|
|
6
|
my $self = shift; |
448
|
2
|
50
|
|
|
|
7
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
449
|
2
|
|
|
|
|
18
|
return $self->{$class} |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub fix_time |
453
|
|
|
|
|
|
|
{ |
454
|
0
|
|
|
0
|
0
|
0
|
my $value = shift; |
455
|
0
|
0
|
0
|
|
|
0
|
$value = "00" if (($value < 0) || ($value > 23)); |
456
|
0
|
|
|
|
|
0
|
$value = int($value); |
457
|
0
|
|
|
|
|
0
|
return $value; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub hour |
461
|
|
|
|
|
|
|
{ |
462
|
2
|
|
|
2
|
0
|
4
|
my $class = "hour"; |
463
|
2
|
|
|
|
|
5
|
my $self = shift; |
464
|
2
|
50
|
|
|
|
8
|
if (@_) |
465
|
|
|
|
|
|
|
{ |
466
|
0
|
|
|
|
|
0
|
$self->{$class} = shift; |
467
|
0
|
|
|
|
|
0
|
$self->{$class} = fix_time($self->{$class}); |
468
|
0
|
|
|
|
|
0
|
$self->{"time"} = sprintf("%2.2d:%2.2d:%2.2d", $self->{"hour"}, $self->{"minute"}, $self->{"second"}); |
469
|
|
|
|
|
|
|
} |
470
|
2
|
|
|
|
|
11
|
return $self->{$class} |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
sub minute |
474
|
|
|
|
|
|
|
{ |
475
|
2
|
|
|
2
|
0
|
5
|
my $class = "minute"; |
476
|
2
|
|
|
|
|
4
|
my $self = shift; |
477
|
2
|
50
|
|
|
|
7
|
if (@_) |
478
|
|
|
|
|
|
|
{ |
479
|
0
|
|
|
|
|
0
|
$self->{$class} = shift; |
480
|
0
|
|
|
|
|
0
|
$self->{$class} = fix_time($self->{$class}); |
481
|
0
|
|
|
|
|
0
|
$self->{"time"} = sprintf("%2.2d:%2.2d:%2.2d", $self->{"hour"}, $self->{"minute"}, $self->{"second"}); |
482
|
|
|
|
|
|
|
} |
483
|
2
|
|
|
|
|
11
|
return $self->{$class} |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub second |
487
|
|
|
|
|
|
|
{ |
488
|
2
|
|
|
2
|
0
|
4
|
my $class = "second"; |
489
|
2
|
|
|
|
|
5
|
my $self = shift; |
490
|
2
|
50
|
|
|
|
7
|
if (@_) |
491
|
|
|
|
|
|
|
{ |
492
|
0
|
|
|
|
|
0
|
$self->{$class} = shift; |
493
|
0
|
|
|
|
|
0
|
$self->{$class} = fix_time($self->{$class}); |
494
|
0
|
|
|
|
|
0
|
$self->{"time"} = sprintf("%2.2d:%2.2d:%2.2d", $self->{"hour"}, $self->{"minute"}, $self->{"second"}); |
495
|
|
|
|
|
|
|
} |
496
|
2
|
|
|
|
|
127
|
return $self->{$class} |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
sub offset |
500
|
|
|
|
|
|
|
{ |
501
|
2
|
|
|
2
|
0
|
4
|
my $class = "offset"; |
502
|
2
|
|
|
|
|
3
|
my $self = shift; |
503
|
2
|
50
|
|
|
|
8
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
504
|
2
|
|
|
|
|
17
|
return $self->{$class} |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
sub method |
508
|
|
|
|
|
|
|
{ |
509
|
2
|
|
|
2
|
0
|
6
|
my $class = "method"; |
510
|
2
|
|
|
|
|
4
|
my $self = shift; |
511
|
2
|
50
|
|
|
|
7
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
512
|
2
|
|
|
|
|
11
|
return $self->{$class} |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
## OBJECT SPECIFIC ROUTINES |
516
|
|
|
|
|
|
|
sub scheme |
517
|
|
|
|
|
|
|
{ |
518
|
2
|
|
|
2
|
0
|
4
|
my $class = "scheme"; |
519
|
2
|
|
|
|
|
4
|
my $self = shift; |
520
|
|
|
|
|
|
|
|
521
|
2
|
|
|
|
|
17
|
my $uri = URI->new($self->{"object"}); |
522
|
2
|
|
|
|
|
6660
|
return $uri->scheme; |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
sub query_string |
526
|
|
|
|
|
|
|
{ |
527
|
2
|
|
|
2
|
0
|
933
|
my $class = "query_string"; |
528
|
2
|
|
|
|
|
3
|
my $self = shift; |
529
|
|
|
|
|
|
|
|
530
|
2
|
|
|
|
|
14
|
my $uri = URI->new($self->{"object"}); |
531
|
2
|
|
|
|
|
93
|
return $uri->query; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
sub path |
535
|
|
|
|
|
|
|
{ |
536
|
4
|
|
|
4
|
0
|
621
|
my $class = "path"; |
537
|
4
|
|
|
|
|
7
|
my $self = shift; |
538
|
|
|
|
|
|
|
|
539
|
4
|
|
|
|
|
17
|
my $uri = URI->new($self->{"object"}); |
540
|
4
|
|
|
|
|
191
|
return $uri->path; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
sub mime_type |
544
|
|
|
|
|
|
|
{ |
545
|
2
|
|
|
2
|
0
|
1297
|
my $self = shift; |
546
|
|
|
|
|
|
|
|
547
|
2
|
|
|
|
|
6
|
my $object = $self->path; |
548
|
2
|
50
|
|
|
|
38
|
if ($object =~ /\.(\w+)$/) |
549
|
|
|
|
|
|
|
{ |
550
|
2
|
|
|
|
|
7
|
my $extension = $1; |
551
|
2
|
|
|
|
|
6
|
$extension =~ tr/A-Z/a-z/; |
552
|
2
|
|
|
|
|
14
|
return $mime_type{$extension}; |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
sub unescape_object |
557
|
|
|
|
|
|
|
{ |
558
|
2
|
|
|
2
|
0
|
5
|
my $self = shift; |
559
|
|
|
|
|
|
|
|
560
|
2
|
|
|
|
|
6
|
my $object = $self->{"object"}; |
561
|
2
|
|
|
|
|
12
|
return uri_unescape($object); |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
sub escape_object |
565
|
|
|
|
|
|
|
{ |
566
|
2
|
|
|
2
|
0
|
580
|
my $self = shift; |
567
|
|
|
|
|
|
|
|
568
|
2
|
|
|
|
|
9
|
my $object = $self->{"object"}; |
569
|
2
|
|
|
|
|
12
|
return uri_escape($object); |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
sub object |
573
|
|
|
|
|
|
|
{ |
574
|
2
|
|
|
2
|
1
|
588
|
my $class = "object"; |
575
|
2
|
|
|
|
|
4
|
my $self = shift; |
576
|
2
|
50
|
|
|
|
12
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
577
|
2
|
|
|
|
|
11
|
uri_unescape($self->{$class}); |
578
|
2
|
|
|
|
|
19
|
return $self->{$class} |
579
|
|
|
|
|
|
|
} |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
sub protocol |
582
|
|
|
|
|
|
|
{ |
583
|
2
|
|
|
2
|
0
|
6
|
my $class = "protocol"; |
584
|
2
|
|
|
|
|
4
|
my $self = shift; |
585
|
2
|
50
|
|
|
|
10
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
586
|
2
|
|
|
|
|
10
|
return $self->{$class} |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
sub response_code |
590
|
|
|
|
|
|
|
{ |
591
|
2
|
|
|
2
|
0
|
5
|
my $class = "response_code"; |
592
|
2
|
|
|
|
|
5
|
my $self = shift; |
593
|
2
|
50
|
|
|
|
8
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
594
|
2
|
|
|
|
|
13
|
return $self->{$class} |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
sub content_length |
598
|
|
|
|
|
|
|
{ |
599
|
2
|
|
|
2
|
0
|
4
|
my $class = "content_length"; |
600
|
2
|
|
|
|
|
4
|
my $self = shift; |
601
|
2
|
50
|
|
|
|
8
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
602
|
2
|
|
|
|
|
13
|
return $self->{$class} |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
sub http_referer |
606
|
|
|
|
|
|
|
{ |
607
|
2
|
|
|
2
|
0
|
5
|
my $class = "http_referer"; |
608
|
2
|
|
|
|
|
6
|
my $self = shift; |
609
|
2
|
50
|
|
|
|
6
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
610
|
2
|
|
|
|
|
13
|
return $self->{$class} |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
sub http_user_agent |
614
|
|
|
|
|
|
|
{ |
615
|
2
|
|
|
2
|
0
|
6
|
my $class = "http_user_agent"; |
616
|
2
|
|
|
|
|
9
|
my $self = shift; |
617
|
2
|
50
|
|
|
|
8
|
if (@_) {$self->{$class} = shift} |
|
0
|
|
|
|
|
0
|
|
618
|
2
|
|
|
|
|
18
|
return $self->{$class} |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
# Autoload methods go after =cut, and are processed by the autosplit program. |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
1; |
625
|
|
|
|
|
|
|
__END__ |