#?SuikaWikiConfig/2.0

Plugin:
  @Name: RequestLog
  @Description:
    @@@: HTTP Request Logging
    @@lang:en
  @License: %%Perl%%
  @Author:
    @@Name:
      @@@@: Wakaba
      @@@lang:ja
      @@@script:Latn
    @@Mail[list]: w@suika.fam.cx
  @Date.RCS:
    $Date: 2004/02/18 07:22:11 $
  @Use:
    use Message::Util::Error;

PluginConst:
  @NS_XHTML1:
    http://www.w3.org/1999/xhtml

FormattingRule:
  @Category[list]:
    view
    view-resource
    form-input
  @Name: rl--log
  @Parameter:
    @@Name: name
    @@Type: name
    @@Default:#REQUIRED
    @@Description:
      @@@: Log category name
      @@lang: en
  @Formatting:
    __ATTRTEXT:%name__;
    my @list;
    try {
      @list = map {[split /\x09/, $_, 2]}
              split /\x0A/,
              $o->{wiki}->{db}->get ('log__http_request',
                                     $o->{wiki}->name ($p->{name} ||
                                       $o->{wiki}->{var}->{page}));
    } catch SuikaWiki::DB::Util::Error with {
      my $err = shift;
      $err->throw if $err->{-type} eq 'ERROR_REPORTED';
    };
    
    if (@list) {
      my $list = $p->{-parent}->append_new_node
                     (type => '#element',
                      namespace_uri => $NS_XHTML1,
                      local_name => 'ol');
      for (sort {$b->[1] <=> $a->[1] or $a->[0] cmp $b->[0]} @list) {
        $list->append_new_node
                     (type => '#element',
                      namespace_uri => $NS_XHTML1,
                      local_name => 'li')
             ->append_text (sprintf '{%d} %s', $_->[1], $_->[0]);
      }
    }

Function:
  @Name: http_request_log
  @Main:
    my (undef, %opt) = @_;
    return if not $opt{wiki}->{db} or not $opt{wiki}->{input};
    $opt{prop} ||= 'log__http_request';
    $opt{ns} ||= [qw/Wiki Log/, (gmtime)[5] + 1900];
    
    ## From HTTP_* CGI meta variables
    for (qw/
      Accept Accept-Charset Accept-Encoding Accept-Language
      Accept-Geo Accept-Features AcceptLanguage
      X-Awg-Client-Protocol-Version X-Awg-Client-Version
      Blonde-Hunter
      Cache-Control X-Cache-ID Cache-Info
      Connection Xonnection Cneonction
      Proxy-Connection Xroxy-Connection
      Content-Disposition Content-Language Content-Transfer-Encoding
      Content-Encoding Content-Feature
      Date
      Extension
      X-EGZ
      From
      X-Filtergate-Request X-IBM-RCA-Request
      If-Modified-Since Unless-Modified-Since If-Match If-None-Match
      If-Range
      Keep-Alive
      X-Locking
      MAX-Forwards
      MIME-Version
      Novinet
      Npfrefr Npfvoid
      Pragma
      ProbixpbContext ProbixpbSignature ProbixpbVersion
      Proxy-----------
      User-Agent Proxy-Agent Wser-Agent X-ICAP-Version X-HTX-Agent Dweb-Client
      Range Request-Range
      Referrer Weferer
      Server-Lover
      X-Sister
      TE Transfer-Encoding
      UA-Color UA-CPU UA-OS UA-Pixels
      X-UP-Subno
      XXXXX XXXXXXX XXXXXXXXXX XXXXXXXXXXXXXXX XXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXX
            ------- ---------- ---------------
    /) {
      (my $mv = uc $_) =~ tr/-/_/;
      __FUNCPACK__->_log_add (%opt,
        value => scalar $opt{wiki}->{input}->meta_variable ('HTTP_'.$mv),
        key => [@{$opt{ns}}, $_]);
    }

    __FUNCPACK__->_log_add (%opt,
        value => scalar $opt{wiki}->{input}->meta_variable ('CONTENT_TYPE'),
        key => [@{$opt{ns}}, 'Content-Type']);
    __FUNCPACK__->_log_add (%opt,
        value => scalar $opt{wiki}->{input}->meta_variable ('REQUEST_METHOD'),
        key => [@{$opt{ns}}, ':request-method']);

    ## Request header field list
    my %ua;
    my $key = [@{$opt{ns}}, ':header-field'];
    for (split /\x0A/, $opt{wiki}->{db}->get ($opt{prop}, $key)) {
      my ($n, $t) = split /\x09/, $_, 2;
      $ua{$n} = $t + 0;	    
    }
    for (grep s/^HTTP_//, $opt{wiki}->{input}->meta_variable_list) {
      (my $v = ucfirst lc $_) =~ tr/_/-/;
      $v =~ s/(?<=-)([a-z])/uc $1/ge;
      $ua{$v}++;
    }
    $opt{wiki}->{db}->set ($opt{prop}, $key
            => join "\x0A", map {$_ . "\x09" . $ua{$_}} keys %ua);    

Function:
  @Name: _log_add
  @Main:
	  my (undef, %opt) = @_;
	  return unless length $opt{value};
    for ($opt{value}) {
      s/([^\x20-\x24\x26-\x5A\x5C-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;
      s/(bypass-client=\d+\.\d+\.)(\d+)\.(\d+)/$1.'[VAR['.('*' x length $2).']].[VAR['.('*' x length $3).']]'/ge;
      s/[0-5]\d:[0-5]\d:[0-5]\d GMT/[VAR[**]]:[VAR[**]]:[VAR[**]] GMT/g;
      s/, (?:[012]\d|3[01])(?=[ -][JFMASOND])/, [VAR[**]]/g;
      s/; length=([0-9]+)/'; length=[VAR['.('*' x length $1).']]'/ge;
    }
	  my %ua;
	  for (split /\x0A/, $opt{wiki}->{db}->get ($opt{prop}, $opt{key})) {
	      my ($n, $t) = split /\x09/, $_, 2;
	      $ua{$n} = $t + 0;	    
	  }
	  $ua{$opt{value}}++;
	  $opt{wiki}->{db}->set ($opt{prop}, $opt{key}
            => join "\x0A", map {$_ . "\x09" . $ua{$_}} keys %ua);