/[pub]/suikawiki/script/misc/plugins/request-log.pm
Suika

Contents of /suikawiki/script/misc/plugins/request-log.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations) (download)
Sun May 16 23:05:49 2010 UTC (16 years, 2 months ago) by wakaba
Branch: MAIN
CVS Tags: suikawiki3-redirect, HEAD
added latest .pm files

1 use strict;
2 package SuikaWiki::Plugin::Registry;
3
4
5 our %Info;
6 $Info{q#RequestLog#}->{Name} = q#RequestLog#;
7 $Info{q#RequestLog#}->{q#Version#} = q#2004.0831.0328#;
8 $Info{q#RequestLog#}->{q#InterfaceVersion#} = q#2.9.1#;
9 $Info{q#RequestLog#}->{q#mkpluginVersion#} = q#2.1.19#;
10 $Info{q#RequestLog#}->{q#module_name#} = q#SuikaWiki::Plugin::plugin::RequestLog1040731032807O9uE#;
11 $Info{q#RequestLog#}->{q#Date.RCS#} = q#$Date: 2004/05/01 03:51:13 $#;
12 $Info{q#RequestLog#}->{RequiredPlugin} = [q#WikiLinking#];
13 $Info{q#RequestLog#}->{Description} = [[q#HTTP Request Logging#, q#en#, q##]];
14 $Info{q#RequestLog#}->{License} = [[q#%%Perl%%#, q##, q##]];
15 $Info{q#RequestLog#}->{Author} = [[[[q#Wakaba#, q#ja#, q#Latn#]], [[q#[email protected]#]], [q##]]];
16 package SuikaWiki::Plugin::plugin::RequestLog1040731032807O9uE;
17
18
19 #line 1 "(WikiPlugin module source request-log.wp2, block Plugin/Use)"
20 use Message::Util::Error;
21 #line 1 "(WikiPlugin module RequestLog, chunk 1)"
22
23 {my $def = {q#Parameter#, {q#name#, {q#Type#, q#name#, q#Default#, q#\#REQUIRED#, q#Description#, [[q##, q##, q##]]}}, q#Description#, [], q#main#, sub {my ($f, $rule_name, $p, $o, %opt) = @_;
24
25 #line 1 "(WikiPlugin module source request-log.wp2, block FormattingRule[name()='[q#view#, q#view-resource#, q#form-input#]/rl__log']/Formatting)"
26 $p->{q#name#} = do { my $r = $f->parse_attr ($p=>q#name#, $o, -non_parsed_to_node => 1, %opt); ref $r?$r->inner_text:$r};
27 my $rlist;
28 my $sub = [];
29 try {
30 my $page = $p->{name};
31 $page ||= $o->{wiki}->{input}->parameter ('rl--for')
32 if $o->{wiki}->{input};
33 $page = $o->{wiki}->name ($page);
34 unshift @$page, @{$o->{wiki}->{config}->{page}->{q#http://suika.fam.cx/~wakaba/-temp/2004/05/01/reqlog\#root#}||[]};
35 $rlist = $o->{wiki}->{db}->get ('log__http_request', $page);
36 $sub->[0] = [$o->{wiki}->{db}->keys ('log__http_request', -ns => $page)];
37 $sub->[1] = [$o->{wiki}->{db}->keys ('log__http_request', -ns => $page,
38 -type => 'ns')];
39 } catch SuikaWiki::DB::Util::Error with {
40 my $err = shift;
41 $err->throw if $err->{-type} eq 'ERROR_REPORTED';
42 };
43 if ($rlist and keys %$rlist) {
44 my $list = $p->{-parent}->append_new_node
45 (type => '#element',
46 namespace_uri => q#http://www.w3.org/1999/xhtml#,
47 local_name => 'ol');
48 for (sort {$rlist->{$b} <=> $rlist->{$a} or $a cmp $b} keys %$rlist) {
49 $list->append_new_node
50 (type => '#element',
51 namespace_uri => q#http://www.w3.org/1999/xhtml#,
52 local_name => 'li')
53 ->append_text (sprintf '{%d} %s', $rlist->{$_}, $_);
54 }
55 }
56 for my $i (0, 1) {
57 if (@{$sub->[$i]}) {
58 my $list = $p->{-parent}->append_new_node
59 (type => '#element',
60 namespace_uri => q#http://www.w3.org/1999/xhtml#,
61 local_name => 'ul');
62 my $template = $o->{wiki}->{plugin}->module_package ('WikiResource')
63 ->get_text (name => 'RequestLog:List:'.[qw/Leaf Node/]->[$i],
64 o => $o, wiki => $o->{wiki});
65 for (sort {$a->[$#$a] cmp $b->[$#$b]} @{$sub->[$i]}) {
66 $o->{wiki}->{plugin}->module_package ('WikiLinking')
67 ->to_wikipage_in_html ({
68 label => $template,
69 } => {
70 page_name => $o->{wiki}->{var}->{page},
71 param => {
72 'rl--for' => $o->{wiki}->name ($_)->stringify (wiki => $o->{wiki}),
73 },
74 }, {
75 parent => $list->append_new_node
76 (type => '#element',
77 namespace_uri => q#http://www.w3.org/1999/xhtml#,
78 local_name => 'li'),
79 o => $o,
80 });
81 }
82 }}}}
83 #line 1 "(WikiPlugin module RequestLog, chunk 2)"
84 ;
85 $SuikaWiki::Plugin::Rule{view}->{rl__log} = $def;
86 $SuikaWiki::Plugin::Rule{view_resource}->{rl__log} = $def;
87 $SuikaWiki::Plugin::Rule{form_input}->{rl__log} = $def;
88 };
89
90
91 sub http_request_log {
92
93 #line 1 "(WikiPlugin module source request-log.wp2, block Function[Name='http_request_log']/Main)"
94 my (undef, %opt) = @_;
95 return if not $opt{wiki}->{db} or not $opt{wiki}->{input};
96 $opt{prop} ||= 'log__http_request';
97 $opt{ns} ||= [@{$opt{wiki}->{config}->{page}->{q#http://suika.fam.cx/~wakaba/-temp/2004/05/01/reqlog\#root#}||[]},
98 (gmtime)[5] + 1900];
99 for (qw/
100 Accept Accept-Charset Accept-Encoding Accept-Language
101 Accept-Geo Accept-Features AcceptLanguage
102 X-Awg-Client-Protocol-Version X-Awg-Client-Version
103 Blonde-Hunter
104 Cache-Control X-Cache-ID Cache-Info
105 Connection Xonnection Cneonction
106 Proxy-Connection Xroxy-Connection
107 Content-Disposition Content-Language Content-Transfer-Encoding
108 Content-Encoding Content-Feature
109 Date
110 Extension
111 X-EGZ
112 From
113 X-Filtergate-Request X-IBM-RCA-Request
114 If-Modified-Since Unless-Modified-Since If-Match If-None-Match
115 If-Range
116 Keep-Alive
117 X-Locking
118 MAX-Forwards
119 MIME-Version
120 Novinet
121 Npfrefr Npfvoid
122 Pragma
123 ProbixpbContext ProbixpbSignature ProbixpbVersion
124 Proxy-----------
125 User-Agent Proxy-Agent Wser-Agent X-ICAP-Version X-HTX-Agent Dweb-Client
126 Range Request-Range
127 Referrer Weferer
128 Server-Lover
129 X-Sister
130 TE Transfer-Encoding
131 UA-Color UA-CPU UA-OS UA-Pixels
132 X-UP-Subno
133 XXXXX XXXXXXX XXXXXXXXXX XXXXXXXXXXXXXXX XXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXX
134 ------- ---------- ---------------
135 /) {
136 (my $mv = uc $_) =~ tr/-/_/;
137 SuikaWiki::Plugin::plugin::RequestLog1040731032807O9uE->_log_add (%opt,
138 value => scalar $opt{wiki}->{input}->meta_variable ('HTTP_'.$mv),
139 key => [@{$opt{ns}}, $_]);
140 }
141 SuikaWiki::Plugin::plugin::RequestLog1040731032807O9uE->_log_add (%opt,
142 value => scalar $opt{wiki}->{input}->meta_variable ('CONTENT_TYPE'),
143 key => [@{$opt{ns}}, 'Content-Type']);
144 SuikaWiki::Plugin::plugin::RequestLog1040731032807O9uE->_log_add (%opt,
145 value => scalar $opt{wiki}->{input}->meta_variable ('REQUEST_METHOD'),
146 key => [@{$opt{ns}}, ':request-method']);
147 my $key = [@{$opt{ns}}, ':header-field'];
148 my $list = $opt{wiki}->{db}->get ($opt{prop}, $key);
149 for (grep s/^HTTP_//, $opt{wiki}->{input}->meta_variable_list) {
150 (my $v = ucfirst lc $_) =~ tr/_/-/;
151 $v =~ s/(?<=-)([a-z])/uc $1/ge;
152 $list->{$v}++;
153 }
154 $opt{wiki}->{db}->set ($opt{prop}, $key => $list);
155 my $list = $opt{wiki}->{db}->get ($opt{prop}, $key);
156 }
157
158 #line 1 "(WikiPlugin module RequestLog, chunk 4)"
159
160
161
162 sub _log_add {
163
164 #line 1 "(WikiPlugin module source request-log.wp2, block Function[Name='_log_add']/Main)"
165 my (undef, %opt) = @_;
166 return unless length $opt{value};
167 for ($opt{value}) {
168 s/([^\x20-\x24\x26-\x5A\x5C-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;
169 s/(bypass-client=\d+\.\d+\.)(\d+)\.(\d+)/$1.'[VAR['.('*' x length $2).']].[VAR['.('*' x length $3).']]'/ge;
170 s/[0-5]\d:[0-5]\d:[0-5]\d GMT/[VAR[**]]:[VAR[**]]:[VAR[**]] GMT/g;
171 s/, (?:[012]\d|3[01])(?=[ -][JFMASOND])/, [VAR[**]]/g;
172 s/; length=([0-9]+)/'; length=[VAR['.('*' x length $1).']]'/ge;
173 }
174 my $list = $opt{wiki}->{db}->get ($opt{prop}, $opt{key});
175 $list->{$opt{value}}++;
176 $opt{wiki}->{db}->set ($opt{prop}, $opt{key} => $list);
177 }
178
179 #line 1 "(WikiPlugin module RequestLog, chunk 5)"
180
181
182 $SuikaWiki::Plugin::Rule{page_link}->{rl__for_param} = {q#Parameter#, {}, q#Description#, [], q#main#, sub {my ($f, $rule_name, $p, $o, %opt) = @_;
183
184 #line 1 "(WikiPlugin module source request-log.wp2, block FormattingRule[name()='[q#page-link#]/rl__for_param']/Formatting)"
185 $p->{-parent}->append_text ($o->{link}->{dest}->{param}->{'rl--for'});}}
186 #line 1 "(WikiPlugin module RequestLog, chunk 6)"
187 ;
188
189 package SuikaWiki::Plugin::Resource;
190
191 our $BaseResource;
192 $BaseResource->{q#und#}->{q##}->{q#RequestLog:List:Leaf#} = q#%link-to-it ( label => {%rl--for-param;}p, );#;
193 $BaseResource->{q#und#}->{q##}->{q#RequestLog:List:Node#} = q#%link-to-it ( label => {%rl--for-param;}p, );#;
194 package SuikaWiki::Plugin::Registry;
195
196 $Info{q#RequestLog#}->{provide} = {q#rule#, {q#form_input#, [q#rl__log#], q#view#, [q#rl__log#], q#view_resource#, [q#rl__log#], q#page_link#, [q#rl__for_param#]}};
197
198 1;

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24