#!/usr/bin/perl -w
#
# IRC RDF Chat Logger
#
# $Source: /usr/local/cvsroot/openacs-4/contrib/packages/irc-logger/perl/logger,v $
# $Id: logger,v 1.3 2013/09/12 14:38:11 victorg Exp $
#
# (C) Copyright 2000-2001 Dave Beckett, ILRT, University of Bristol
# http://purl.org/net/dajobe/
#
# with modifications from Ralph Swick
# http://www.w3.org/People/all#swick
#
#   This program is free software; you can redistribute it and/or
#   modify it under the terms of the GNU General Public License
#   as published by the Free Software Foundation; either version 2
#   of the License, or (at your option) any later version.
#   
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#   
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
# 
# See http://www.gnu.org/copyleft/gpl.html
#
# For documentation run perldoc on this file 'perldoc logger'
#

use strict;

# Standard Perl modules
use File::Path;
use File::Basename;
use Sys::Hostname;
use Getopt::Long;
use IO::Handle;
use Encode;

# From CPAN
use URI;
use Net::IRC;


%ENV=();
$ENV{PATH}='/bin:/usr/bin:/usr/local/bin';


# Global constants
$::program=basename $0;

$::Host=(hostname || 'unknown');

$::Nick='logger'; # OK this can be changed if clashes
$::IRC_Name='Chat Logger';

$::LogActionMsgs=1;
$::LogUserHosts=0;
$::OffTopic=1;        # [off] at start of line is not logged

@::LogTypes=qw(rdf html txt);
@::DefaultLogTypes=qw(rdf txt);

# ugly system dependencies
# MSWin does not permit ":" in file path components
$::PortSep = $^O eq "MSWin32" ? "/" : ":";

$::html_suffix="</dl>\n</body>\n</html>\n";
$::html_suffix_length=undef;	# account for \n to \r\n expansion in stdio

$::rdf_suffix="    </rdf:Seq>\n  </foaf:chatEventList>\n</foaf:ChatChannel>\n</rdf:RDF>\n";
$::rdf_suffix_length=undef;	# account for \n to \r\n expansion in stdio

#URIschemes and URIpatterns must match in order.  The order is not signficant.
@::URIschemes = (
    'http://',
    'news:',
    'ftp://',
    'file://',
    'gopher://',
    'nntp://',
    'wais://',
    'telnet://',
    'prospero://',
    'mailto:'
    );

@::URIpatterns = (
    qr|(http://)([^] \)>\"\'\n\[\t\\]*)(.*)$|,
    qr|(news:)([^] \)>"\'\n[\t\\]*)(.*)$|,
    qr|(ftp://)([^] \)>"\'\n[\t\\]*)(.*)$|,
    qr|(file://)([^] \)>"\'\n[\t\\]*)(.*)$|,
    qr|(gopher://)([^] \)>"\'\n[\t\\]*)(.*)$|,
    qr|(nntp://)([^] \)>"\'\n[\t\\]*)(.*)$|,
    qr|(wais://)([^] \)>"\'\n[\t\\]*)(.*)$|,
    qr|(telnet://)([^] \)>"\'\n[\t\\]*)(.*)$|,
    qr|(prospero://)([^] \)>"\'\n[\t\\]*)(.*)$|,
    qr|(mailto:)([^] \)>"\'\n[\t\\]*)(.*)$|,
    );



# Global variables

# IRC object
$::IRC=undef;

# root dir of logs
$::Log_Root='';

# place on the web this corresponds to
$::Log_URI='';

# System password
$::Password='';

# Print welcome message?
$::Do_Welcome=0;

# True if leaving (so don't reconnect)
$::Departing=0;

# True if connecting (don't log server notices)
$::Connecting=0;

# Administrative messages log
$::Admin_LOG=undef;

# Process ID
$::PID_File=undef;

# On connect /msg $user $cmd
$::Connect_User=undef;
$::Connect_CMD=undef;


######################################################################
package URI::irc;

# http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
# irc:[ //[ <host>[:<port>] ]/[<target>] [,needpass] ]

require URI::_server;

@URI::irc::ISA=qw(URI::_server);

sub default_port { 6667 }

sub channel ($) {
  my $path=shift->path;
  if($path && $path =~ m%^/([^/]+)%) {
    return $1;
  }
  undef;
}

package main;

# this hideous concatenation only serves to hide this source line from CVS
# The objective is to create a regex pattern that matches all CVS/RCS keywords
$::CVSkeywords = '\$'.'Date\$|\$'.'Date:.*\$|\$'.'Revision\$|\$'.'Revision:.*\$|\$'.'Author\$|\$'.'Author:.*\$|\$'.'Id\$|\$'.'Id:.*\$|\$'.'Log\$|\$'.'Log:.*\$|\$'.'Header\$|\$'.'Header:.*\$|\$'.'Locker\$|\$'.'Locker:.*\$|\$'.'Name\$|\$'.'Name:.*\$|\$'.'RCSfile\$|\$'.'RCSfile:.*\$|\$'.'Source\$|\$'.'Source:.*\$|\$'.'State\$|\$'.'State:.*\$';

######################################################################


sub main {
  my $usage=<<"EOT";
Usage: $::program [option...] password channel-URI channel-title log-dir log-URI
  where option is one or more of:
   -html	    write an XHTML log
   -notext	    Do not write a text log
   -log <logfile>   Write logs to logfile rather than the default
                    of channel/YYYY-MM-DD
                    (\".txt\", \".html\", and \".rdf\" will be appended)
   -nick <nick>     set the nick
   -connectuser <user> on connect /msg this user
   -connectcmd <cmd>   with this command

   -noaction	    Do not log /me messages
   -noofftopic      Do not ignore lines starting with [off]
   -userhosts       Record user\@host in /join messages

  and channel-URI is like irc://host[:port]/channel
EOT

  my(%do_log_types)=map {$_ => 1} @::DefaultLogTypes;
  my $log_name=undef;
  die $usage unless GetOptions ('action!' => \$::LogActionMsgs,
		       'html!'	 => \$do_log_types{'html'},
		       'text!'	 => \$do_log_types{'txt'},
		       'log=s'	 => \$log_name,
		       'nick=s'	 => \$::Nick,
		       'connectuser=s'	 => \$::Connect_User,
		       'connectcmd=s'	 => \$::Connect_CMD,
		       'userhost!' => \$::LogUserHosts,
		       'offtopic!' => \$::OffTopic,
		      ) && @ARGV==5;

  @::DefaultLogTypes=grep($do_log_types{$_}, @::LogTypes);

  my($password,$uri_string,$channel_title, $log_root, $log_uri_string)=@ARGV;

  my $uri;
  eval '$uri=new URI $uri_string';
  die "$::program: '$uri_string' does not look like an IRC URI\n" 
    if ($@ || !$uri);


  die "$::program: log dir $log_root does not exist\n" unless -d $log_root;

  # Set globals
  $::Password=$password;
  $::Log_Root=$log_root;
  $::Log_URI=$log_uri_string;
  $::Do_Welcome=0;
  $::Departing=0;
  $::Connecting=1;

  # Open the administrative log file
  my $admin_log_file=$::Log_Root.'/admin.log';

  $::Admin_LOG=new IO::File;
  $::Admin_LOG->open(">>$admin_log_file") 
    or die "$::program Failed to append to admin log file $admin_log_file - $!\n";
  $::Admin_LOG->autoflush(1);

  umask 022;

  # FIXME - pid_file should not have channel in it, when logger
  # handles multiple channels
  my $channel_name=$uri->channel;
  $::PID_File=$::Log_Root.'/logger-'.$channel_name.'.pid';
  open(PID,">$::PID_File");
  print PID "$$\n";
  close(PID);

  $::IRC = new Net::IRC;

  my $channel=&Channel_new($uri, $channel_title, $log_name);

  Channel_join($channel);

  # Never returns
  $::IRC->start;
}


# MAIN CODE
&main;

exit(0);


######################################################################
# Methods on 'logger Channel' object
# package Logger::Channel;

@::Channels=();

sub Channel_new ($$$) {
  my($uri,$title,$log_name)=@_;

  my $self={};

  # Channel title
  $self->{Title}=$title;

  # irc:: URI
  $self->{URI}=$uri;

  # a file prefix to log to (i.e. write log_name.rdf etc.) or undef
  # to use default schema
  $self->{LogName}=$log_name;

  # topic of channel
  $self->{Topic}='';

  # Last ID seen
  $self->{Last_ID}='';

  # True if logging
  $self->{Listening}=0;

  # Track midnight rollover
  $self->{hour}= undef;

  # NET::IRC connection object
  $self->{CONN}=undef;

  $self->{LogTypes}=[@::DefaultLogTypes];
  for my $type (@{$self->{LogTypes}}) {
    $self->{FH}->{$type}=undef;
  }

  # Prefix of log files - add ".html" etc. to give file name
  $self->{LogFilePrefix}=undef;

  # Prefix of log URIs or undef if no URI
  $self->{LogURIPrefix}=undef;

  push(@::Channels, $self);

  $self;
}


sub Channel_join($) {
  my($self)=@_;

  my $uri=$self->{URI};

  my $channel_name=$uri->channel;

  $self->{Listening}=1;

  my $user_name=substr($channel_name,0,8)."-logger";

  my $conn = $::IRC->newconn(Nick    => $::Nick,
			     Server  => $uri->host,
			     Port    => $uri->port,
			     Ircname => $::IRC_Name,
			     Username => $user_name,
			     LocalAddr => $::Host);

  die "$::program: Cannot create connection to $uri\n" 
    unless $conn;

  $self->{CONN}=$conn;
  
  Channel_open_logs($self);

  # Install handlers
  # On 'end of MOTD' event, join ilrt channel
  $conn->add_global_handler(376, \&on_connect);
  $conn->add_global_handler('nomotd', \&on_connect);
  $conn->add_global_handler(353, \&on_names);
  $conn->add_global_handler('disconnect', \&on_disconnect);

  $conn->add_handler('msg', \&on_msg);
  $conn->add_handler('public', \&on_public);
  $conn->add_handler('part', \&on_part);
  $conn->add_handler('join', \&on_join);
  $conn->add_handler('kick', \&on_kick);
  $conn->add_handler('caction', \&on_caction);
  $conn->add_handler('quit', \&on_quit);
  $conn->add_handler('nick', \&on_nick);
  $conn->add_handler('nicknameinuse', \&on_nicknameinuse);
  $conn->add_handler('topic', \&on_topic);
  $conn->add_handler('notice', \&on_notice);

}

sub Channel_by_conn($) {
  my $conn=shift;
  for my $channel (@::Channels) {
    return $channel if $channel->{CONN} == $conn;
  }
}


sub Channel_get_log_dir ($) {
  my $self=shift;

  my $uri=$self->{URI};
  my $channel_name=$uri->channel; $channel_name=~ s/\W//g;

  return $::Log_Root.'/'.$uri->host.$::PortSep.$uri->port.'/'.$channel_name.'/';
}


sub Channel_get_log_lines ($) {
  my $self=shift;

  my(@file_dates);

  if (my $log_name=$self->{LogName}) {
    @file_dates=["$log_name.txt", undef];
  } else {
    my $log_dir=Channel_get_log_dir($self);

    return () if !opendir(DIR, $log_dir);

    for my $file (reverse sort readdir(DIR)) {
      next unless $file =~ /^(\d\d\d\d-\d\d-\d\d).txt/;
      my $date=$1;
      push(@file_dates, ["$log_dir/$file", $date]);
    }
    closedir(DIR);
  }

  # In date order, newest lines at top
  my(@results)=();
  # Newest files first
  for my $file_date (@file_dates) {
    my($file,$date)=@$file_date;
    open(LOG, $file) or next;
    
    # Append to list, reverse date sorted list - i.e. older entries at end 
    my(@lines);
    while(<LOG>) {
      chomp;
      # Ignore logger's own output
      next if m%^\d\d:\d\d:\d\d <$::Nick>%;
      next if !length $_;
      $_="$date $_" if $date;
      push(@lines, $_);
    };
    close(LOG);
    push(@results, reverse @lines);
  }

  return(@results);
}


sub Channel_open_logs ($) {
  my $self=shift;

  my $conn=$self->{CONN};
  my $uri=$self->{URI};
  my $channel_name=$uri->channel;

  my @tm = gmtime;
  $tm[5]+= 1900; $tm[4]++;
  my $date = sprintf("%04d-%02d-%02d", $tm[5], $tm[4], $tm[3]);

  my(%log_files);
  
  if (my $log_name=$self->{LogName}) {
    $self->{LogFilePrefix}=$log_name;
    $self->{LogURIPrefix}=$::Log_URI if $::Log_URI;
  } else {
    my $log_dir=Channel_get_log_dir($self);
    
    mkpath([$log_dir], 0, 0755) if ! -d $log_dir;
    # Failed!
    if (! -d $log_dir) {
      log_admin_event($self, undef, time, "Failed to create chat log dir $log_dir - $!");
      unlink $::PID_File;
      exit(0);
    }
    $self->{LogFilePrefix}=$log_dir."/".$date;
    $self->{LogURIPrefix}=$::Log_URI.$date if $::Log_URI;
  }

  for my $type (@{$self->{LogTypes}}) {
    $log_files{$type}=$self->{LogFilePrefix}.".".$type;
  }


  if (grep($_ eq 'txt', @{$self->{LogTypes}})) {
    my $txt_log_fh=$self->{FH}->{txt}=new IO::File;
    my $txt_log_file=$log_files{txt};
    
    if (!$self->{FH}->{txt}->open(">>$txt_log_file")) {
      log_admin_event($self, undef, time, "Failed to create text log file $txt_log_file - $!");
      unlink $::PID_File;
      exit(0);
    }

    $txt_log_fh->autoflush(1);
  }


  if (grep($_ eq 'html', @{$self->{LogTypes}})) {
    my $html_log_fh;
    my $html_log_file=$log_files{html};

    if (!-r $html_log_file) {	# new file?
      $html_log_fh=$self->{FH}->{html}=new IO::File;
      if (!$html_log_fh->open(">$html_log_file")) {
	log_admin_event($self, undef, time, "Failed to create HTML log file $html_log_file - $!");
	unlink $::PID_File;
	exit(0);
      }

      my $escaped_chan = xml_escape($channel_name);
      print $html_log_fh <<"EOT";
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
 <title>IRC log of $escaped_chan on $date</title>
EOT
      my $progID = '$Id: logger,v 1.3 2013/09/12 14:38:11 victorg Exp $';
      $progID =~ s/\$/\&#36;/g;	# Hide the CVS tag from CVS in the output
      print $html_log_fh '<meta name="generator" content="'.$progID.'" />';
      print $html_log_fh <<"EOT";

 <style type="text/css">
  .IRC { font-family: sans-serif }
 </style>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
</head>
<body>
<h1>IRC log of $escaped_chan on $date</h1>
<p><em>Timestamps are in UTC.</em></p>
<dl class="IRC">
EOT
      print $html_log_fh $::html_suffix;
    } else {
      $html_log_fh=$self->{FH}->{html}=new IO::File;
      if (!$html_log_fh->open("+<$html_log_file")) {
	log_admin_event($self, undef, time, "Failed to append to HTML log file $html_log_file - $!");
        unlink $::PID_File;
        exit(0);
      }
    }

    # figure out whether stdio expands NEWLINE to CRLF
    if (!defined $::html_suffix_length) {
	seek($html_log_fh, 0, 2);	# find the end
	my $curlen = tell($html_log_fh);
	print $html_log_fh $::html_suffix;
	$::html_suffix_length = tell($html_log_fh) - $curlen;
	truncate ($html_log_fh, $curlen);
    }

    $html_log_fh->autoflush(1);
  }


  # Note RDF log type is not optional ;-)
  my $rdf_log_fh;
  my $rdf_log_file=$log_files{rdf};
  if(!-r $rdf_log_file) {
    $rdf_log_fh=$self->{FH}->{rdf}=new IO::File;

    if (!$rdf_log_fh->open(">$rdf_log_file")) {
      log_admin_event($self, undef, time, "Failed to create RDF log file $rdf_log_file - $!");
      unlink $::PID_File;
      exit(0);
    }

    my $escaped_chan_uri = xml_escape($self->{URI});
    print $rdf_log_fh <<"EOT";
<?xml version="1.0" encoding="UTF-8"?>
<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
         xmlns:dc="http://purl.org/dc/elements/1.1/"
         xmlns:wn="http://xmlns.com/wordnet/1.6/"
         xmlns:foaf="http://xmlns.com/foaf/0.1/">
<foaf:ChatChannel rdf:about="$escaped_chan_uri">
  <foaf:chatEventList>
    <rdf:Seq>
EOT
    print $rdf_log_fh $::rdf_suffix;
  } else {
    $rdf_log_fh=$self->{FH}->{rdf}=new IO::File;
    if (!$rdf_log_fh->open("+<$rdf_log_file")) {
      log_admin_event($self, undef, time, "Failed to append to RDF log file $rdf_log_file - $!");
      unlink $::PID_File;
      exit(0);
    }
  }

  # figure out whether stdio expands NEWLINE to CRLF
  if (!defined $::rdf_suffix_length) {
      seek($rdf_log_fh, 0, 2);	# find the end
      my $curlen = tell($rdf_log_fh);
      print $rdf_log_fh $::rdf_suffix;
      $::rdf_suffix_length = tell($rdf_log_fh) - $curlen;
      truncate ($rdf_log_fh, $curlen);
  }

  $self->{FH}->{rdf}->autoflush(1);
}


sub Channel_close_logs ($) {
  my $self=shift;
  for my $type (@{$self->{LogTypes}}) {
    $self->{FH}->{$type}->close;
    $self->{FH}->{$type}=undef;
  }
}


######################################################################
# Logging - methods on Net::IRC::Connection object

sub log_event ($$$;$) {
  my($self, $event, $t, $msg)=@_;
  my $nick=$event->nick;

  my $channel=Channel_by_conn($self);

  return if !$channel->{Listening};

  my @tm = gmtime($t);
  $tm[5]+= 1900; $tm[4]++;
  my $date = sprintf("%04d-%02d-%02d", $tm[5], $tm[4], $tm[3]);
  my $time = sprintf("%02d:%02d:%02d", $tm[2], $tm[1], $tm[0]);
  my $date_time="$date $time";

  my $hour=$tm[2];
  # if we're using dated logs and we passed midnight, start new logs
  if (!$channel->{LogName} &&
      defined $channel->{hour} && ($hour < $channel->{hour})) {
    Channel_close_logs($channel);
    Channel_open_logs($channel);
  }

  $channel->{hour} = $hour;


  $msg=ensure_utf8($msg);

  if (grep($_ eq 'txt', @{$channel->{LogTypes}})) {
    my $txt_msg=$nick ? qq{<$nick> $msg} : $msg;
    my $txt_log_fh=$channel->{FH}->{txt};
    print $txt_log_fh "$time $txt_msg\n";
  }


  # Make a legal XML id from the time
  my $ID="T$time"; $ID =~ s/:/-/g;

  # add a unique suffix if necessary
  if(length($channel->{Last_ID}) != length($ID)) {
    # If last ID was in same second, need to start from next
    # ID HH-MM-SS-X and increment X
    # otherwise, new ID is OK
    if ($channel->{Last_ID} =~ /^$ID-(\d+)$/) {
      $ID.="-".($1+1);
    }
  } elsif($ID eq $channel->{Last_ID}) {
    # Else if was same as last ID, must be first duplicate of this
    # ID in this time slot ie last id was HH-MM-SS so add -1 to make 
    # it unique HH-MM-SS-1
    $ID.="-1";
  }
  $channel->{Last_ID}=$ID;

  my @uris = getURI($msg);

  if (grep($_ eq 'html', @{$channel->{LogTypes}})) {
    my $html_log_fh=$channel->{FH}->{html};

    # seek back
    # @@ note that this assumes the existing data was NL-expanded identically
    seek($html_log_fh, -$::html_suffix_length, 2); # 2= SEEK_END

    my $escapedMsg = cvs_escape($msg);
    if ($#uris > -1) {
	$escapedMsg = URI2link($escapedMsg, @uris);
    }

    print $html_log_fh qq{<dt id="$ID">$time [$nick]</dt><dd>}.$escapedMsg.qq{</dd>\n};
    print $html_log_fh $::html_suffix;
  }


  my $rdf_log_fh=$channel->{FH}->{rdf};

  # seek back
  # @@ note that this assumes the existing data was NL-expanded identically
  seek($rdf_log_fh, -$::rdf_suffix_length, 2); # 2= SEEK_END

  print $rdf_log_fh <<"EOT";
      <rdf:li>
       <foaf:chatEvent rdf:ID="$ID">
        <dc:date>${date}T${time}Z</dc:date>
EOT
  print $rdf_log_fh qq{        <dc:description>}.cvs_escape($msg).qq{</dc:description>\n};
  print $rdf_log_fh qq{        <dc:creator><wn:Person foaf:nick="$nick"/></dc:creator>\n} if $nick;
  foreach my $uri (@uris) {
    $uri = xml_escape($uri);
    print $rdf_log_fh qq{        <dc:relation rdf:resource="$uri"/>\n};
  }
  print $rdf_log_fh qq{       </foaf:chatEvent>\n};
  print $rdf_log_fh qq{      </rdf:li>\n};
  print $rdf_log_fh $::rdf_suffix;
}



sub log_admin_event ($$$;$) {
  my($self, $event, $t, $msg)=@_;
  my $nick=$event ? $event->nick : '';

  my @tm = gmtime($t);
  $tm[5]+= 1900; $tm[4]++;
  my $date = sprintf("%04d-%02d-%02d", $tm[5], $tm[4], $tm[3]);
  my $time = sprintf("%02d:%02d:%02d", $tm[2], $tm[1], $tm[0]);

  my $txt_msg=$nick ? qq{<$nick> $msg} : $msg;
  if($::Admin_LOG) {
    print $::Admin_LOG "${date}Z${time} $txt_msg\n";
  } else {
    warn "${date}Z${time} $txt_msg\n";
  }
}


######################################################################
# Global events

# What to do when logger successfully connects.
sub on_connect {
  my ($self, $event) = @_;
  
  my $channel=Channel_by_conn($self);

  my $channel_name;

  if ($channel->{URI}->channel =~ m/[\#&]/) {
      $channel_name = $channel->{URI}->channel; # don't add a prefix if one was given
  } else {
      $channel_name ='#' . $channel->{URI}->channel; # else assume a public channel
  }

  if($::Connect_User && $::Connect_CMD) {
    $self->privmsg($::Connect_User, $::Connect_CMD);
  }

  log_admin_event($self, $event, time, "Connected to server");

  $self->join($channel_name);
  $channel->{Listening}=1;
  $self->me($channel_name, 'is logging');
}


# What to do when logger's nick is already used
sub on_nicknameinuse {
  my ($self, $event) = @_;
  
  if ($::Nick !~ /_/) {
    $::Nick.="_1";
  } else {
    my($name,$number)=split(/_/, $::Nick);
    $::Nick=$name."_".($number+1);
  }
  $self->nick($::Nick);
}


# Prints the names of people in a channel when we enter.
sub on_names {
  my ($self, $event) = @_;
  my (@list, $channel_name) = ($event->args);
  
  # splice() only works on real arrays. Sigh.
  ($channel_name, @list) = splice @list, 2;
  
  log_event($self, $event, time, "Users on $channel_name: @list");

  $::Connecting=0;
}


# Reconnect to the server when we die.
sub on_disconnect {
  my ($self, $event) = @_;
  
  my $t=time;
  my $m="Disconnected from ". $event->from(). " (". ($event->args())[0]. ")";
  log_admin_event($self, $event, $t, $m);
  log_event($self, $event, $t, $m);

  return if $::Departing;

  log_admin_event($self, $event, time, "Attempting to reconnect");
  unlink $::PID_File;
  exit(0);
}


######################################################################
# Per connection events


# When received a private message
sub on_msg {
  my($self,$event)=@_;
  my $nick = $event->nick;
  my $channel_name = $event->to;

  return if $nick eq $::Nick;

  my $arg = join(' ', $event->args);
  command_for_me($self, $event, $channel_name, $arg, 1);
}


# What to do when we receive channel text.
sub on_public {
  my ($self, $event) = @_;
  my @to = $event->to;
  my ($nick, $mynick) = ($event->nick, $self->nick);
  my $arg = join(' ', $event->args);

  # Private stuff
  return if ($::OffTopic && $arg =~ /^\[off\]/i);

  log_event($self, $event, time, $arg);

  if ($arg =~ /^$mynick[,:]\s*(.*)$/i) {
    command_for_me($self, $event, $to[0], $1, 0);
  }
}


# What to do when we receive /me (and other stuff??)
sub on_caction {
  my ($self, $event) = @_;
  my $nick = $event->nick;
  my $arg = join(' ', $event->args);

  # Private stuff
  return if !$::LogActionMsgs ||
            ($::OffTopic && $arg =~ /^\[off\]/i);

  log_event($self, $event, time, "* $nick $arg");
}


# What to do when someone leaves a channel logger is on.
sub on_part {
  my ($self, $event) = @_;
  my ($channel_name) = ($event->to)[0];
  my $nick=$event->nick;

  log_event($self, $event, time, "$nick has left $channel_name");
}


# What to do when we receive channel notice (mostly other bots)
sub on_notice {
  my ($self, $event) = @_;
  my $nick = $event->nick;
  my $arg = join(' ', $event->args);

  # Private stuff
  return if ($::OffTopic && $arg =~ /^\[off\]/i);

  return if $::Connecting;

  log_event($self, $event, time, $arg);
}



# What to do when someone leaves a channel logger is on.
sub on_quit {
  my ($self, $event) = @_;
  my $nick=$event->nick;
  my $arg = join(' ', $event->args);
  my $msg="$nick has quit";

  $msg.=" ($arg)" if $::LogUserHosts;
  log_event($self, $event, time, $msg);
}


# What to do when someone is kicked on a channel logger is on.
sub on_kick {
  my ($self, $event) = @_;
  my $nick=$event->nick;
  my $whom = ($event->to)[0];
  my $channel_name = ($event->args)[0];
  my $msg="$nick has kicked $whom from $channel_name";
  log_event($self, $event, time, $msg);
}


# What to do when someone does /nick
sub on_nick {
  my ($self, $event) = @_;
  my $nick=$event->nick;
  my $arg = join(' ', $event->args);
  log_event($self, $event, time, "$nick is now known as $arg");
}


# What to do when someone does /topic MSG
sub on_topic {
  my ($self, $event) = @_;
  my $channel=Channel_by_conn($self);

  my $nick=$event->nick;
  my(@args)=$event->args;
  my $arg;
  if(@args == 3) {
    $arg=$args[2];
    log_event($self, $event, time, "topic is: $arg");
  } else {
    $arg=$args[0];
    log_event($self, $event, time, "$nick has changed the topic to: $arg");
  }
  $channel->{Topic}=$arg;
}


# What to do when someone joins a channel logger is on.
sub on_join {
  my ($self, $event) = @_;
  my $channel=Channel_by_conn($self);

  my ($channel_name) = ($event->to)[0];
  my $user_nick=$event->nick;

  my $format=$::LogUserHosts ? "%s (%s) has joined $channel_name" :
                               "%s has joined $channel_name";
  my $t=time;
  my $m=sprintf($format, $user_nick, $event->userhost);
  log_event($self, $event, $t, $m);
  if($user_nick eq $::Nick) {
    log_admin_event($self, $event, $t, $m);
  }

  return if !$::Do_Welcome;

  my $logging=($channel->{Listening}) ? "logging" : "not logging";

  my(@intro)=(
   "Welcome to the $channel->{Title}",
   "I'm currently $logging to $::Log_URI",
   "For extensive help do: /msg $::Nick help"
  );

  my $do_sleep=0;
  for my $output (@intro) {
   sleep(1) if $do_sleep;
   $self->privmsg($event->nick, $output);
   $do_sleep=1;
  }
}


sub command_for_me ($$$$$) {
  my($self, $event, $channel_name, $command, $is_private)=@_;
  my $channel=Channel_by_conn($self);
  my $from_nick=$event->nick;

  $command=~s/^\s+//;

  my $output='';

  my $dest_nick=($is_private ? $from_nick : $event->to);

  my $valid_password=0;
  if($command =~ s/^password (\S+)\s*//) {
    if($1 eq $::Password) {
      $valid_password=1;
    } else {
      $self->privmsg($dest_nick, "Invalid password");
      return;
    }
  }

  if($valid_password) {

    if($command=~ /^(?:quit|finish|terminate|die die die|exterminate|bye|excuse us)/i) {
      $::Departing=1;
      $self->me($event->to, 'is departing');
      # Log who told me to quit
      log_admin_event($self, $event, time, "Logger told to quit");
      $self->quit;
      unlink $::PID_File;
      exit(0);
    }
  
    if($command eq 'restart') {
      $::Departing=1;
      $self->me($event->to, ' is departing');
      $self->quit;
      sleep(1);
      $::Connecting=1;
      $self->connect();
      return;
    }
  
    if($command eq 'debug') {
      $self->privmsg($dest_nick, "Debugging is on");
      $self->debug(1);
      return;
    }
    
    if($command eq 'nodebug') {
      $self->privmsg($dest_nick, "Debugging is off");
      $self->debug(0);
      return;
    }
  }
  
  if($command=~ /^(?:be quiet|shut up|silence|sshush|stop|off|nolisten)/i) {
    if($channel->{Listening}) {
      $self->me($event->to, 'is not logging');
      # Log who turned me off
      log_admin_event($self, $event, time, "Logging turned off");
      $channel->{Listening}=0;
    } else {
      $self->me($event->to, 'is already not logging');
    }
    return;
  }
  
  if($command=~ /^(?:hello|log|listen|record|start|begin|on|listen)/i) {
    if(!$channel->{Listening}) {
      $self->me($event->to, 'is logging');
      # Log who turned me on
      log_admin_event($self, $event, time, "Logging turned on");
      $channel->{Listening}=1;
    } else {
      $self->me($event->to, 'is already logging');
    }
    return;
  }

  if($command=~ /^(?:sync)/i) {
    Channel_close_logs($channel);
    Channel_open_logs($channel);
    return;
  }

  if($command=~ /^(?:pointer|bookmark|here|where am i\?)/i) {
    my($log_uri)=$channel->{LogURIPrefix};

    my $output;
    if($log_uri) {
      $log_uri.="#".$channel->{Last_ID} if $channel->{Last_ID};
      $output="See $log_uri";
    } else {
      $output="There is no log URI";
    }
    $self->privmsg($dest_nick, $output);
    log_event($self, $event, time, $output) unless $is_private;
    return;
  }

  if($command=~ /^chump\s*(.+)$/i) {
    my $item=$1;
    my($log_uri)=$channel->{LogURIPrefix};

    my $output;
    my $chump=undef;
    if($item =~ /^([A-Za-z]+):?$/) {
      $chump=uc $1;
      $chump=undef if $chump eq 'BLURB';
    }

    if(!$chump) {
      $output="Invalid chump item $item";
    } elsif($log_uri) {
      $log_uri.="#".$channel->{Last_ID} if $channel->{Last_ID};
      $output="$chump:See [$log_uri|discussion]";
    } else {
      $output="There is no log URI";
    }
    $self->privmsg($dest_nick, $output);
    log_event($self, $event, time, $output) unless $is_private;
    return;
  }

  if(!$channel->{Listening}) {
    $output="I'm not logging. ";
  } else {
    $output="I'm logging. ";
  }

  # Allow question?
  if ($command =~ /^(.+)\?$/) {
    $command="grep $1";
  }

  if($command=~ /^help/i) {
    my(@help)=(
      "The commands I know are:",
      " silence      - Stop logging (also: stop, off, ...)",
      " listen       - Start logging (also: start, on, ...)",
      " bookmark     - Give the URI of the current log",
      " chump LETTER - Record the URI of the current log under chump LETTER",
      "I respond to '$::Nick, command' in public and '/msg $::Nick command' in private",
      "Logging Policy: All public output is logged if I am listening except for"
    );
    if (! $::LogActionMsgs) {
      @help=(@help,
         "\"action\" messages (messages sent with the '/me' command) and"
     );
    }
    @help=(@help,
      "any lines starting [off].   All commands to me are logged.",
      "My public output is logged but these lines are not searchable.",
      "The logs are at $::Log_URI",
      "Do $::Nick, adminhelp for help on administrative commands",
    );
    my $do_sleep=0;
    for my $output (@help) {
      sleep(1) if $do_sleep;
      $self->privmsg($dest_nick, $output);
      $do_sleep=1;
    }
    return;
  }

  if($command =~ /^adminhelp/i) {
    my(@help)=(
      "Administrative commands are as follows:",
      "  quit        - I will depart",
      "  restart     - I will leave and rejoin channel",
      "  debug       - Turn on debugging",
      "  nodebug     - Turn off debugging",
      "These commands work only with the admin PASSWORD like this:",
      "/msg $::Nick password PASSWORD command'",
    );
    my $do_sleep=0;
    for my $output (@help) {
      sleep(1) if $do_sleep;
      $self->privmsg($dest_nick, $output);
      $do_sleep=1;
    }
    return;
  }

  if ($command =~ /^(?:grep|search for|find)\s+(.+)$/) {
    $output.=qq{Sorry, searching removed.};
  } else {
    $output.="I don't understand '$command', $from_nick.  Try /msg $::Nick help";
  }

  $self->privmsg($dest_nick, $output);
  log_event($self, $event, time, $output) unless $is_private;
}


######################################################################
# Utility subroutines

sub ensure_utf8 ($) {
  my $text = shift;

  # If it cannot be decoded as UTF-8...
  my $t="<fake>".$text."</fake>";
  eval { decode("utf8", $t, Encode::FB_CROAK); };
  if($@) {
    # Assume it is latin-1 (there is no real IRC encoding), encode as UTF-8
    $text=encode("utf8", decode("iso-8859-1", $text), Encode::FB_QUIET);
  }

  $text;
}


# Escape any special characters that are significant to XML
# Then hide any CVS/RCS tags from future invocations of CVS/RCS

sub cvs_escape ($) {
  my ($text) = @_;

  $text = xml_escape($text);

  return $text if ($text !~ /\$/o); # nothing to hide

  if ($text =~ /$::CVSkeywords/o) {
      $text =~ s/\$/&#36;/g;
  }
  return $text;
}

sub xml_escape ($) {
  my $string=shift;
  $string =~ s/\&/\&amp;/g;
  $string =~ s/</\&lt;/g;
  $string =~ s/>/\&gt;/g;
  $string =~ s/[\x00-\x1F]//g;  # remove ASCII 0-31
# Output is UTF-8, so don't throw away high characters
#  $string =~ s/([\x80-\xFF])/"\&#".ord($1).";"/ge; # escape ASCII 128-255
  $string;
}


# URI recognition
# The following URI recognition algorithm was translated from
# the Hypermail implementation; see parseurl() in
# http://dev.w3.org/cvsweb/~checkout~/hypermess/hypermail/src/string.c?rev=1.4

#returns a list of any URIs found in the input string
sub getURI ($)
{
    my ($l) = @_;
    my @ret = ();

    if ($l !~ /:/o) {		# give up if input can't have any schemes
	return ();
    }

    chomp $l;

    while (my $leftmost = length ($l)) { # while string is not empty
	my $i = 0;
	my $match = -1;
	foreach my $u (@::URIschemes) {	# search for first matching URI scheme
	    my $p = index( $l, $u );
	    if ($p >= 0 && $p < $leftmost) {
		$leftmost = $p;
		$match = $i;
	    }
	    $i++;
	}

	if ($match != -1) {	# if a scheme was found, extract the URI
	    $l = substr($l, $leftmost);
	    my $u = $l;
	    $u =~ s/$::URIpatterns[$match]/$1$2/;
	    $l = $3;		# rest of string after extracting the pattern
	    @ret=(@ret, $u);
	} else {
	    $l = "";
	}
    }

    return @ret;
}

#Return a string with any URIs specified by the second argument (a list)
#found in the first argument expanded to HTML anchors
sub URI2link ($@)
{
    my ($l, @uri) = @_;

    chomp $l;

    foreach my $u (@uri) {
	my $p = quotemeta $u;
	$l =~ s/($p)/<a href="$1">$1<\/a>/;
    }

    return $l;
}

__END__

=pod

=head1 NAME

logger - RDF IRC Chat Logger

=head1 SYNOPSIS

  logger [options...] PASSWORD CHANNEL-URI CHANNEL-TITLE LOG-DIR LOG-URI > logger.log

An irc logger bot that automatically generated logs for various IRC
chat channels.  Call it with parameters above where

  PASSWORD      Administrator password for some commands
  CHANNEL-URI   IRC channel URI like irc://host[:port]/channel
  CHANNEL-TITLE A title to use in welcome messages
  LOG-DIR       Root directory to start writing logs
  LOG-URI       URI of where the logs appear on the web

and options are:

  -html          Write an XHTML log as well as text and RDF.
  -log LOGFILE   Write logs to LOGFILE rather than the default
                 of CHANNEL/YYYY-MM-DD (".txt", ".html", and ".rdf"
                 will be appended)
  -nick NICK     Use IRC nick NICK

  -noaction      Do not log /me messages
  -noofftopic    Do not ignore lines starting with [off]
  -userhosts     Record user@host from /join messages

=head1 DESCRIPTION

The logger bot listens to the chat channel and records it in public
logs which are written live in three formats - RDF, plain text and
HTML (usually created from RDF via XSLT by some other program).

Logger accepts a few commands that can be done publically with
  logger, COMMAND
or privately with
  /msg logger COMMAND

The full list of commands can be found by the help command
  /msg logger help

Logger can be told to stop listening/recording to the chat, if for
some reason this is required.  For individual messages this can be
done by putting the phrase '[off]' at the start of a line of text and
for longer conversations, tell logger to stop listening with:
  logger, off
and recording again with 
  logger, on
(there are other synonyms).  The on/off messages are logged, as well as
all public commands to logger.  This feature can be turned off
with -noofftopic

The current log URI, and the position in it can be queried at any time
with
  logger, pointer
or using one of the other aliases: here, bookmark, where am i?

The current log URI can be recorded in a particular chump bot item
using:
  logger, chump D
to record the discussion below item D.

Logger has some administrative commands that can be found from:
  /msg logger adminhelp

These require the startup password in order to use, for example this
will make logger terminate:
  /msg logger password PASSWORD quit

logger will attempt to reconnect when disconnected but doesn't yet
handle all network problems very gracefully.

=head2 LICENSE

GNU GPL version 2 or later - see http://www.gnu.org/copyleft/gpl.html

=head2 AUTHOR

Dave Beckett - http://purl.org/net/dajobe/, 
Institute for Learning and Research Technology, http://ilrt.org/,
University of Bristol.

with lots of changes from
Ralph Swick - http://www.w3.org/People/all#swick,
W3C/MIT

=cut