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

Diff of /suikawiki/script/misc/plugins/request-log.wp2

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wakaba, Wed Feb 18 07:22:11 2004 UTC revision 1.2 by wakaba, Sat May 1 03:51:13 2004 UTC
# Line 16  Plugin: Line 16  Plugin:
16      $Date$      $Date$
17    @Use:    @Use:
18      use Message::Util::Error;      use Message::Util::Error;
19      @Namespace:
20        @@log:
21          http://suika.fam.cx/~wakaba/-temp/2004/05/01/reqlog#
22      @RequiredPlugin[list]:
23        WikiLinking
24    
25  PluginConst:  PluginConst:
26    @NS_XHTML1:    @NS_XHTML1:
# Line 36  FormattingRule: Line 41  FormattingRule:
41        @@lang: en        @@lang: en
42    @Formatting:    @Formatting:
43      __ATTRTEXT:%name__;      __ATTRTEXT:%name__;
44      my @list;      my $rlist;
45        my $sub = [];
46      try {      try {
47        @list = map {[split /\x09/, $_, 2]}        my $page = $p->{name};
48                split /\x0A/,        $page ||= $o->{wiki}->{input}->parameter ('rl--for')
49                $o->{wiki}->{db}->get ('log__http_request',          if $o->{wiki}->{input};
50                                       $o->{wiki}->name ($p->{name} ||        $page = $o->{wiki}->name ($page);
51                                         $o->{wiki}->{var}->{page}));        unshift @$page, @{$o->{wiki}->{config}->{page}->{<Q:log:root>}||[]};
52          $rlist = $o->{wiki}->{db}->get ('log__http_request', $page);
53          $sub->[0] = [$o->{wiki}->{db}->keys ('log__http_request', -ns => $page)];
54          $sub->[1] = [$o->{wiki}->{db}->keys ('log__http_request', -ns => $page,
55                                               -type => 'ns')];
56      } catch SuikaWiki::DB::Util::Error with {      } catch SuikaWiki::DB::Util::Error with {
57        my $err = shift;        my $err = shift;
58        $err->throw if $err->{-type} eq 'ERROR_REPORTED';        $err->throw if $err->{-type} eq 'ERROR_REPORTED';
59      };      };
60            
61      if (@list) {      if ($rlist and keys %$rlist) {
62        my $list = $p->{-parent}->append_new_node        my $list = $p->{-parent}->append_new_node
63                       (type => '#element',                       (type => '#element',
64                        namespace_uri => $NS_XHTML1,                        namespace_uri => $NS_XHTML1,
65                        local_name => 'ol');                        local_name => 'ol');
66        for (sort {$b->[1] <=> $a->[1] or $a->[0] cmp $b->[0]} @list) {        for (sort {$rlist->{$b} <=> $rlist->{$a} or $a cmp $b} keys %$rlist) {
67          $list->append_new_node          $list->append_new_node
68                       (type => '#element',                       (type => '#element',
69                        namespace_uri => $NS_XHTML1,                        namespace_uri => $NS_XHTML1,
70                        local_name => 'li')                        local_name => 'li')
71               ->append_text (sprintf '{%d} %s', $_->[1], $_->[0]);               ->append_text (sprintf '{%d} %s', $rlist->{$_}, $_);
72        }        }
73      }      }
74    
75        for my $i (0, 1) {
76        if (@{$sub->[$i]}) {
77          my $list = $p->{-parent}->append_new_node
78                         (type => '#element',
79                          namespace_uri => $NS_XHTML1,
80                          local_name => 'ul');
81          my $template = $o->{wiki}->{plugin}->module_package ('WikiResource')
82                       ->get_text (name => 'RequestLog:List:'.[qw/Leaf Node/]->[$i],
83                                       o => $o, wiki => $o->{wiki});
84          for (sort {$a->[$#$a] cmp $b->[$#$b]} @{$sub->[$i]}) {
85            $o->{wiki}->{plugin}->module_package ('WikiLinking')
86              ->to_wikipage_in_html ({
87              label => $template,
88            } => {
89              page_name => $o->{wiki}->{var}->{page},
90              param => {
91                'rl--for' => $o->{wiki}->name ($_)->stringify (wiki => $o->{wiki}),
92              },
93            }, {
94              parent => $list->append_new_node
95                         (type => '#element',
96                          namespace_uri => $NS_XHTML1,
97                          local_name => 'li'),
98              o => $o,
99            });
100          }
101        }}
102    
103  Function:  Function:
104    @Name: http_request_log    @Name: http_request_log
105    @Main:    @Main:
106      my (undef, %opt) = @_;      my (undef, %opt) = @_;
107      return if not $opt{wiki}->{db} or not $opt{wiki}->{input};      return if not $opt{wiki}->{db} or not $opt{wiki}->{input};
108      $opt{prop} ||= 'log__http_request';      $opt{prop} ||= 'log__http_request';
109      $opt{ns} ||= [qw/Wiki Log/, (gmtime)[5] + 1900];      $opt{ns} ||= [@{$opt{wiki}->{config}->{page}->{<Q:log:root>}||[]},
110                      (gmtime)[5] + 1900];
111            
112      ## From HTTP_* CGI meta variables      ## From HTTP_* CGI meta variables
113      for (qw/      for (qw/
# Line 122  Function: Line 161  Function:
161          key => [@{$opt{ns}}, ':request-method']);          key => [@{$opt{ns}}, ':request-method']);
162    
163      ## Request header field list      ## Request header field list
     my %ua;  
164      my $key = [@{$opt{ns}}, ':header-field'];      my $key = [@{$opt{ns}}, ':header-field'];
165      for (split /\x0A/, $opt{wiki}->{db}->get ($opt{prop}, $key)) {      my $list = $opt{wiki}->{db}->get ($opt{prop}, $key);
166        my ($n, $t) = split /\x09/, $_, 2;  
       $ua{$n} = $t + 0;      
     }  
167      for (grep s/^HTTP_//, $opt{wiki}->{input}->meta_variable_list) {      for (grep s/^HTTP_//, $opt{wiki}->{input}->meta_variable_list) {
168        (my $v = ucfirst lc $_) =~ tr/_/-/;        (my $v = ucfirst lc $_) =~ tr/_/-/;
169        $v =~ s/(?<=-)([a-z])/uc $1/ge;        $v =~ s/(?<=-)([a-z])/uc $1/ge;
170        $ua{$v}++;        $list->{$v}++;
171      }      }
172      $opt{wiki}->{db}->set ($opt{prop}, $key      $opt{wiki}->{db}->set ($opt{prop}, $key => $list);
173              => join "\x0A", map {$_ . "\x09" . $ua{$_}} keys %ua);          my $list = $opt{wiki}->{db}->get ($opt{prop}, $key);
174    
175  Function:  Function:
176    @Name: _log_add    @Name: _log_add
177    @Main:    @Main:
178            my (undef, %opt) = @_;      my (undef, %opt) = @_;
179            return unless length $opt{value};      return unless length $opt{value};
180      for ($opt{value}) {      for ($opt{value}) {
181        s/([^\x20-\x24\x26-\x5A\x5C-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;        s/([^\x20-\x24\x26-\x5A\x5C-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;
182        s/(bypass-client=\d+\.\d+\.)(\d+)\.(\d+)/$1.'[VAR['.('*' x length $2).']].[VAR['.('*' x length $3).']]'/ge;        s/(bypass-client=\d+\.\d+\.)(\d+)\.(\d+)/$1.'[VAR['.('*' x length $2).']].[VAR['.('*' x length $3).']]'/ge;
# Line 148  Function: Line 184  Function:
184        s/, (?:[012]\d|3[01])(?=[ -][JFMASOND])/, [VAR[**]]/g;        s/, (?:[012]\d|3[01])(?=[ -][JFMASOND])/, [VAR[**]]/g;
185        s/; length=([0-9]+)/'; length=[VAR['.('*' x length $1).']]'/ge;        s/; length=([0-9]+)/'; length=[VAR['.('*' x length $1).']]'/ge;
186      }      }
187            my %ua;  
188            for (split /\x0A/, $opt{wiki}->{db}->get ($opt{prop}, $opt{key})) {      my $list = $opt{wiki}->{db}->get ($opt{prop}, $opt{key});
189                my ($n, $t) = split /\x09/, $_, 2;      $list->{$opt{value}}++;
190                $ua{$n} = $t + 0;          $opt{wiki}->{db}->set ($opt{prop}, $opt{key} => $list);
191            }  
192            $ua{$opt{value}}++;  FormattingRule:
193            $opt{wiki}->{db}->set ($opt{prop}, $opt{key}    @Category[list]: page-link
194              => join "\x0A", map {$_ . "\x09" . $ua{$_}} keys %ua);    @Name: rl--for-param
195      @Formatting:
196        $p->{-parent}->append_text ($o->{link}->{dest}->{param}->{'rl--for'});
197    
198    Resource:
199      @RequestLog:List:Leaf:
200        %link-to-it (
201          label => {%rl--for-param;}p,
202        );
203      @RequestLog:List:Node:
204        %link-to-it (
205          label => {%rl--for-param;}p,
206        );
207    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24