#!/usr/local/bin/perl
#
# The MIT License
#
# Copyright (c) 2008 puni at moemoe dot group\h\h\h dot japan^h^h^h
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.
#
# plumの出力するログファイル解析たん


use strict;
use warnings;
use Encode qw/ encode decode /;
use vars qw/ %opt %channel %temp $plum /;
use Getopt::Std;

# ISO 6429
 use Term::ANSIColor qw(:constants);
# $Term::ANSIColor::AUTORESET = 0;
# RED GREEN YELLOW BLUE MAGENTA CYAN WHITE

my %opt = ();
my %channel = ();

getopt("io" => \%opt);
$opt{i} ||= 'jis';
$opt{o} ||= 'eucjp';

push @ARGV, '-' unless @ARGV;

&readlog( \*ARGV, \%channel );

&show_users( \%channel );
&show_channels( \%channel );

exit;

# --------------------------------------------------------------------
# jis -> sjis -> h2z -> euc?
sub code
{
 no strict 'refs';
#  return &{ 'plum\'' . "$opt{i}_$opt{o}"}(shift);
 return encode( $opt{o}, decode( $opt{i} , shift ) );
}

# --------------------------------------------------------------------
sub show_channels
{
 my( $channel ) = @_;
 my %temp = ();

 no strict 'refs';
 foreach my $name (sort keys %$channel) {
  foreach my $chan (sort keys %{$$channel{$name}}) {
   next if( $chan eq "" );
   $temp{$chan} .= RED . "@" . RESET if( $$channel{$name}{$chan} =~ /\+o+/ );
   $temp{$chan} .= BLUE . "+" . RESET if( $$channel{$name}{$chan} =~ /\+v+/ );
   $temp{$chan} .= "$name ";
  }
 }

 foreach my $chan (sort keys %temp) {
  my $chan_v = &code( $chan );
  print GREEN . "$chan_v:" . RESET . " $temp{$chan}
";
 }


}

# --------------------------------------------------------------------
sub show_users
{
 my( $channel ) = @_;
 no strict 'refs';

 foreach my $name (sort keys %$channel) {
  print GREEN . "$name $$channel{$name}{''}
";
  print "  channels: ";
  foreach my $chan (sort keys %{$$channel{$name}}) {
   next if( $chan eq "" );
   print RED . "@" . RESET if( $$channel{$name}{$chan} =~ /\+o+/ );
   print BLUE . "+" . RESET if( $$channel{$name}{$chan} =~ /\+v+/ );
   my $chan_v = &code( $chan );
   print RESET . "$chan_v ";
  }
  print "
";
 }

}

# --------------------------------------------------------------------
sub readlog
{
 no strict 'refs';
 my( $file, $channel ) = @_;

 my %pattern;
 $pattern{'='} = '=';
 $pattern{'<'} = '>';
 $pattern{'>'} = '<';
 $pattern{'('} = ')';
 $pattern{')'} = '(';

 while(my $line = <$file>){
  chomp $line;
# time <chan:name> priv
# time - name part
# time ! name quit
# time + name (user) to chan
# time name -> name

  my ($time, $mode, $line) = split( / +/, $line, 3 );

  printf BOLD . BLUE . "%s:%s", $$$file, $time;
 # printf BOLD . BLUE . "%s(%4d):%s", $$$file, $., $time;

  if( ($mode =~ /^([\(\)\<\>=])/) )
  {
#  [mode]                     [line]
#  [chan] [name]              [line]
# "<$vchan:$nick>             $params[1]"   @ss_privmsg
# "($vchan:$nick)             $params[1]"   @ss_privmsg
# "=$nick=                    $params[1]"   @ss_privmsg
# "<$vchan:$nick>             $params[1]"   @ss_notice
# "($vchan:$nick)             $params[1]"   @ss_notice
# "=$nick=                    $params[1]"   @ss_notice
# ">$vchan:$'nick[$serverno]< $params[1]"   @sp_privmsg
# ">$chan<                    $params[1]"   @sp_privmsg
# ">$vchan:$'nick[$serverno]< $params[1]"   @sp_notice
# ">$chan<                    $params[1]"   @sp_notice
#
   my $pat = $+;
   # priv
   $mode =~ s/^[\(\)\<\>=]//;
   $mode =~ s/[\(\)\<\>=]$//;

   my($chan, $name) = split( /:/, $mode, 2);
   if($name) {
    $$channel{$name}{''} = "" unless($$channel{$name}{''});
    $$channel{$name}{$chan} = "" unless($$channel{$name}{$chan});
   }
   else {
    # priv
    $$channel{$chan}{''} = "" unless($$channel{$chan}{''});
    $$channel{$chan}{$chan} = "" unless($$channel{$chan}{$chan});
   }
   $chan = &code( $chan );
   $line = &code( $line );
   if($name) {
    printf BOLD . RED . " $pat%s:%s$pattern{$pat} " . RESET . "%s", $chan, $name, $line;
   }
   else {
    printf BOLD . RED . " $pat%s$pattern{$pat} " . RESET . "%s", $chan, $line;
   }
  }
  else
  {
# [mode] [name] [mask] [opt] [line]
   my ($name, $mask, $opt) = ();
   ($name, $mask, $opt, $line) = split( / /, $line, 4 );
   if( $mode =~ /^\!/ ) {
#  [mode] [name]     [mask]       [opt] [line]
# "!      $nick      ($params[0])"                            @ss_quit
    delete $$channel{$name};
    print BOLD . RED;
   }
   elsif( $mode =~ /^\-/ ) {
#  [mode] [name]     [mask] [opt]   [line]
# "-      $nick      from   $vchan  ($params[1])"             @ss_part
# "-      $params[1] by     $nick   from $vchan ($params[2])" @ss_kick
    my $chan;
    my $nick;
    if( $mask eq "by" ) {
     (undef, $chan, undef) = split( / /, $line, 3 );
     $nick = $opt;
    }
    elsif( $mask eq "from" ) {
     $chan = $opt;
     $nick = $name;
    }
    delete $$channel{$nick}{$chan};
    print BOLD . RED;
   }
   elsif( $mode =~ /^\+/ ) {
#  [mode] [name]  [mask]    [opt] [line]
# "+      \@$nick ($prefix) to    $vchan"                     @ss_join
# "+      +$nick  ($prefix) to    $vchan"                     @ss_join
# "+       $nick  ($prefix) to    $vchan"                     @ss_join
# $opt='to' $line=<channel>
    my $op = '';
    if( $name =~ /^([\@\+])/ )
    {
     $op   = $1;
     $name = $';
    }

    $$channel{$name}{''}    = $mask;
    $$channel{$name}{$line} = $op;
    print BOLD . CYAN;
   }
   elsif( $mode eq 'Mode' )
   {
#  [mode] [name] [mask] [opt]      [line]
#                                  [mode] [users]
# "Mode   by     $nick: $vchan     " . join(' ', @mode)       @ss_mode
# "Mode   by     $nick: $params[0] " . join(' ', @mode)       @ss_mode
# $mask = by, $opt = name,
    my($mode, $users) = split( / /, $line, 2 );
    if( $mode =~ /[vo]/ ) {
     my @modes = unpack("C*", $mode);
     my $mode_base = shift @modes;
     if( $users )
     {
      foreach(split( /[ ,]/, $users ))
      {
       $$channel{$_}{$opt} = sprintf( "%c%c", $mode_base, shift @modes);
      }
     }
    }
    print BOLD . GREEN;
   }
   elsif($name eq "-\>") {
#  [mode]  [name] [mask]     [opt]   [line]
# "My      nick   is         changed ($nick -\> $params[0])"  @ss_nick
# "$nick   ->     $params[0]"                                 @ss_nick
    my($nick_o,$nick_n) = ($mode, $mask);
    $$channel{$nick_o}{''} = "" unless($$channel{$nick_o}{''});
    $$channel{$nick_o} = "" unless($$channel{$nick_o});
    $$channel{$nick_n} = $$channel{$nick_o};
    delete $$channel{$nick_o};

    print BOLD . MAGENTA;
   }
   elsif($mode eq 'My' && $name eq 'nick' && $mask eq 'is' && $opt eq 'changed') {
#  [mode]  [name] [mask]     [opt]   [line]
# "My      nick   is         changed ($nick -\> $params[0])"  @ss_nick
    $line =~ s/^\(//;
    $line =~ s/\)$//;

    my($nick_o,undef,$nick_n) = split( / /, $line, 3);
    $$channel{$nick_o}{''} = "" unless($$channel{$nick_o}{''});
    $$channel{$nick_o} = "" unless($$channel{$nick_o});
    $$channel{$nick_n} = $$channel{$nick_o};
    delete $$channel{$nick_o};

    print BOLD . MAGENTA;
   }
   else
   {
#  [mode]  [name] [mask]  [opt] [line]
# "Invited by     $nick:  $vchan"                             @ss_invite
# "Topic   of     channel $vchan by $nick: $params[1]"        @ss_topic

   }
   $mode = &code( $mode );
   $name = &code( $name );
   $mask = &code( $mask );
   $opt = &code( $opt );
   $line = &code( $line );

   print " $mode" if($mode);
   print " $name" if($name);
   print " $mask" if($mask);
   print " $opt" if($opt);
   print " $line" if($line);
  }
  print "
";
 }
 printf RESET;

 return ;
}




__DATA__
- log/dairy.plm 用解析

# perl log.pl -o sjis log0804*
で、４月分全部とか。

# tail -f log080422 | perl log.pl -o sjis -
とか、してリアルタイムログ表示とか。