#!/usr/bin/perl -w
#
# IRC Chat Logger
#
# $Source: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/perl/logger,v $
# $Id: logger,v 1.4 2003/05/29 19:54:54 bartt Exp $
#
# (C) Copyright 2000-2002 Dave Beckett, ILRT, University of Bristol
# http://purl.org/net/dajobe/
#
# enhancements to Dave's work
# Copyright (c) 2001, 2002 Ralph Swick, Massachusetts Institute of Technology
# 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 POSIX qw(strftime);

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


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

my $AdminChannel;		# channel for administrative messages
$::LogInitial = 1;		# log the initial channel

my $ReaperThreshold = 0;	# seconds since last 'interesting' message
				#   after which bot resigns from channel
				# 0 disables auto-parting
my $ReaperScheduled = 0;	# reap idle channels semaphore

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

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

$::Nick='logger'; # OK this can be changed if clashes
$::IRC_Name='Chat Logger';
$::Max_Results=5;
$::Max_Max_Results=20;
$::CVSCommitInterval = 120;	# seconds between CVS commits if -cvs specified

$::LogActionMsgs=1;
$::LogUserHosts=0;
$::OffTopic=1;        # [off] at start of line is not logged
$::HelpURI = undef;		# URI for detailed help

@::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\\]*)(.*)$|, # "
    );

$::ActionDropped = 'dropped';


# Global variables

# IRC object
$::IRC=undef;

# directory for admin logs; '/' will be added.  Also default log dir
$::AdminDir='.';

# root dir of logs; prepended to LogName_Pattern
$::Log_LocalPath=undef;		# include '/' if you need it

# path & POXIX::strftime() pattern for logs.
# '<channel>' will be replaced with the channel name, less leading '#' and '&'
# '.html', '.rdf', '.txt' will be appended
$::LogName_Pattern=undef;
$::Default_Pattern = '<channel>/%Y-%m-%d';

# True if handles meeting action item commands
$::Do_Actions=0;

$::ActionLogName_Pattern=undef;
$::Default_ActionPattern = '<channel>/%Y-%m-%d-actions';

$::Do_CVS=0;			# if logs are to be committed to CVS
$::TestMode=0;			# if system() is to be no-op'd

# place on the web this corresponds to; prepended to LogName_Pattern
$::Log_URI='';			# include '/' if you need one

# System password
$::Password='';

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

# Allow invites
$::Do_Invites=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;

# Channel name (added by bartt)
$::Channel_Name=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="Usage: $::program [option...] PASSWORD CHANNEL-URI\n";
  # From __DATA__ section below
  my $scanning=0;
  while(<DATA>) {
    if(!$scanning) {
      $scanning=1 if /PASSWORD CHANNEL-URI/;
    } else {
      last if /=head1/;
      $usage.=$_;
    }
  }

  my(%do_log_types)=map {$_ => 1} @::DefaultLogTypes;

  print $::program,': $Id: logger,v 1.4 2003/05/29 19:54:54 bartt Exp $',"\n";

  die $usage unless GetOptions (
			'actions!'  => \$::Do_Actions,
			'admin=s'   => \$::AdminDir,
			'alog=s'    => \$::ActionLogName_Pattern,
			'cvs!'      => \$::Do_CVS,
			'invites'   => \$::Do_Invites,
			'helpuri=s' => \$::HelpURI,
			'html!'	    => \$do_log_types{'html'},
			'idleparttime=s' => \$ReaperThreshold,
			'initiallog!' => \$::LogInitial,
			'log=s'	    => \$::LogName_Pattern,
			'lroot=s'   => \$::Log_LocalPath,
			'me!'       => \$::LogActionMsgs,
			'nick=s'    => \$::Nick,
			'offtopic!' => \$::OffTopic,
			'system!'   => \$::TestMode,
			'text!'	    => \$do_log_types{'txt'},
			'uroot=s'   => \$::Log_URI,
			'userhost!' => \$::LogUserHosts,
		      ) && @ARGV==2;

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

  my($password,$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);

  # replace '<server>' in $::Log_LocalPath and $::Log_URI
  my $server = $uri->host.$::PortSep.$uri->port;
  $::Log_LocalPath =~ s/<server>/$server/
    if $::Log_LocalPath;
  $::Log_URI =~ s/<server>/$server/
    if $::Log_URI;

  if ($::Log_LocalPath) {
    die "$::program: log dir $::Log_LocalPath does not exist\n"
	  unless -d $::Log_LocalPath;
  }

  die "$::program: admin dir $::AdminDir does not exist\n"
	unless -d $::AdminDir;

  # Set globals
  $::Password=$password;
  $::Departing=0;
  $::Connecting=1;

  # Open the administrative log file
  my $admin_log_file=$::AdminDir.'/'.$::Nick.'.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=$::AdminDir.'/'.$::Nick.'-'.$channel_name.'.pid';
  open(PID,">$::PID_File");
  print PID "$$\n";
  close(PID);

  # Store channel name in global parameter for later reference in
  # on_msg.  bartt
  $::Channel_Name = $uri->channel;

  $::IRC = new Net::IRC;

  my $channel=&Channel_new($uri);
  $AdminChannel = $channel;
  Channel_join($channel);

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


# MAIN CODE
&main;

exit(0);


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

@::Channels=();			# [] -> {CONN}, {NAME}, {URI}, {Topic}, {Title}
				# {Listening}, {MsgTime}, {LogFilePrefix},
				# {LogURIPrefix}, {CVSFiles}, {LogTypes}
				# {CVSCommitScheduled}, {LogsOpen}
				# {ActionItems} {IgnoreActions}
				# {LogName} - unused as of 2002-02-18 but
				# 	      kept for possible future use
				# {ActionLog}

				# ActionItems[] -> {Topic}, {Pointer}, {id}

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

  my $self={};

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

  my $channel_name = $uri->channel;
  $channel_name ='#' . $channel_name unless $channel_name =~ m/^[\#&]/;

  $self->{NAME} = $channel_name;

  # Channel title
  $self->{Title}=$channel_name.' channel';

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

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

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

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

  $self->{LogsOpen} = 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;

  # 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}=$::LogInitial;

  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) if $::LogInitial;

  # Install handlers
  # On 'end of MOTD' event, join channel
  $conn->add_global_handler(376, \&on_connect);
  $conn->add_global_handler('welcome', \&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);
  $conn->add_handler('invite', \&on_invite);

  # turn off CTCP ACTION warnings from Net::IRC::Connection.pm
  BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if not $_[0] =~ m/^ONE:/ } }

  # turn off CTCP ACTION warnings from Net::IRC::Connection.pm
  # Not required for Net::IRC 0.71 or later
  BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if not $_[0] =~ m/^ONE:/ } }

}

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


sub Channel_by_name($) {
  my $name=shift;
  for my $channel (@::Channels) {
    return $channel if $channel->{NAME} =~ m/^\Q$name\E$/i;
  }
  return undef;
}


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

  return $::Log_LocalPath if $::Log_LocalPath;

  # %%% need something special for $self->{LogFilePrefix} ?

  my $uri=$self->{URI};
  return $uri->host.$::PortSep.$uri->port.'/';
}


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

  my(@file_dates);

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

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

    my $name = $self->{NAME};
    $name =~ s/^[#&]//;

    for my $file (reverse sort readdir(DIR)) {
      next unless $file =~ /.*$name.*\.txt/;
#     $file =~ m/^(\d\d\d\d-\d\d-\d\d)/;
      # %%% need to generalize this date-extraction from $::LogName_Pattern
      $file =~ m/^([-\d]*)/;	# any number of leading hyphen-separated digits
      my $date=$1;
      $date =~ s/-$//;		# trim a trailing hyphen if one exists
      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 $channel_name=$self->{NAME};
  $channel_name =~ s/^[#&]//;

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

  my(%log_files);

  my $log_dir='./';
  if (my $log_name=$self->{LogName}) {
    $self->{LogFilePrefix}=$log_name;
    $self->{LogURIPrefix}=$::Log_URI if $::Log_URI;
  } else {
    my $logname;
    if ($::LogName_Pattern) {
      $log_name = strftime( $::LogName_Pattern, gmtime );
    }
    else {
      $log_name = strftime( $::Default_Pattern, gmtime );
      $log_dir=Channel_get_log_dir($self);

    }
    $log_name =~ s/<channel>/$channel_name/;

    $self->{LogBasename} = $log_name;
    $self->{LogFilePrefix} =
	  ($::Log_LocalPath ? $::Log_LocalPath : $log_dir).$log_name;
    $self->{LogURIPrefix} = $::Log_URI.$log_name if $::Log_URI;
  }
		       
		       
  my $dir=dirname($self->{LogFilePrefix});
  if (! -d $dir) {
    mkpath([$dir], 0, 0755);
    # Failed!
    if (! -d $dir) {
      log_admin_event($self, undef, time, "Failed to create chat log dir $dir - $!");
      unlink $::PID_File;
      return;
    }
  }
		  
  print "$::program: Opening ",$self->{LogFilePrefix},"\n";

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

  my $cvs_files = '';

  if (grep($_ eq 'txt', @{$self->{LogTypes}})) {
    $cvs_files .= $self->{LogBasename}.'.txt ' if $::Do_CVS;
    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;
      return;
    }

    $txt_log_fh->autoflush(1);
  }


  if (grep($_ eq 'html', @{$self->{LogTypes}})) {
    $cvs_files .= $self->{LogBasename}.'.html ' if $::Do_CVS;
    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;
	return;
      }

      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.4 2003/05/29 19:54:54 bartt 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;
        return;
      }
    }

    # 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 ;-)
  $cvs_files .= $self->{LogBasename}.'.rdf ' if $::Do_CVS;
  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;
      return;
    }

    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;
      return;
    }
  }

  # 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);
  $self->{LogsOpen} = 1;

  if ($cvs_files) {
      $self->{CVSFiles} = $cvs_files;
      $self->{CVSCommitScheduled} = 0;
      my $ECHO = $::TestMode ? 'echo ' : '';
      system(("${ECHO}sh -c 'cd $::Log_LocalPath; cvs add $cvs_files &'"));
  }
}


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


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

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

  my $channel=Channel_by_name(($event->to)[0]);

  return if !$channel || !$channel->{Listening};

  Channel_open_logs($channel) unless $channel->{LogsOpen};

  $channel->{MsgTime} = time;

  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;

  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;

  if ($::Do_CVS && !$channel->{CVSCommitScheduled} && $channel->{CVSFiles}) {
    my $ECHO = $::TestMode ? 'echo ' : '';
    $self->schedule( $::CVSCommitInterval,
		     sub
		     {
			 system(("${ECHO}sh -c 'cd $::Log_LocalPath; cvs commit -m \"[$::Nick] sync\" ".$channel->{CVSFiles}." &'"));
			 $channel->{CVSCommitScheduled} = 0;
		     }
		    );
    $channel->{CVSCommitScheduled} = 1;
  }
}



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 = $channel->{NAME};

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

  $self->join($channel_name);
}


# 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);
  log_pending_output($self);

  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;

  # The above channel_name blocks private responses to commands issued
  # on a public channel. Ugly hack: use the name of the initial
  # channel instead . But.... it works. bartt

  $channel_name = "#$::Channel_Name";

  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);
  }
  else {
    watch_significant_events($self, $event, $to[0], $arg, 0, 0);
  }

  if ($ReaperThreshold && !$ReaperScheduled) {
      $self->schedule( $ReaperThreshold/4, \&ReapIdleChannels, $self );
      $ReaperScheduled = 1;
  }
}


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

  if ($arg =~ /^$mynick,\s+(.*)$/i) {
    command_for_me($self, $event, @{$event->to}[0], $1, 0);
  }
  else {
    watch_significant_events($self, $event, @{$event->to}[0], $arg, 0, 0);
  }

  # 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");
}


# We've been invited to a channel
sub on_invite {
  my ($self, $event) = @_;
  my $nick = $event->nick;
  my $arg = join('~', $event->args);

  my @args = $event->args;
  my $channel_name = $args[0];
  my $channel_password = $args[1]; # maybe

  return if !$::Do_Invites;

  log_admin_event($self, $event, time, "Invited to $channel_name ($arg)");

  $self->join($channel_name, $channel_password);
}


# 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);
  log_admin_event($self, $event, time, $msg);
  my $channel = Channel_by_name($channel_name);
  if ($channel) {
    Channel_close_logs($channel);
    $channel->{Listening} = 0;
    for (my $index=0; $index <= $#::Channels; $index++) {
	if ($::Channels[$index] == $channel) {
	    splice(@::Channels, $index, 1);
	    last;
	}
    }
  }
  else {
    my $msg = "Unknown channel from $nick on $channel_name";
    log_admin_event($self, $event, time, $msg);
    print $msg, "\n";
  }
}


# 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_name(($event->to)[0]);

  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_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);

  my $channel = Channel_by_name($channel_name);
  if (!$channel) {
      $channel_name =~ s/^#//;	# Net::IRC doesn't permit leading '#'
      my $t_uri = $AdminChannel->{URI};
      my $uri_string = 'irc://'.$t_uri->host.':'.$t_uri->port.'/'.$channel_name;
      my $uri = new URI $uri_string;
      $channel = &Channel_new($uri);
      $channel->{CONN} = $self;
      $channel->{MsgTime} = time;
      $channel->{Listening} = 1; # Always join in listen mode
      # %%% could this be executed if we depart the AdminChannel and rejoin?
      $channel->{Listening} = $::LogInitial if $channel == $AdminChannel;
      Channel_open_logs($channel);
  }

  log_event($self, $event, $t, $m);

  if($user_nick eq $::Nick) {
    log_admin_event($self, $event, $t, $m);
    $channel->{Listening} = 1; # Always join in listen mode
    $channel->{Listening} = $::LogInitial if $channel == $AdminChannel;
    Say( $self,
	 $event->to,
	 $channel->{Listening} ? 'is logging' : 'is not logging',
	 0
        );
    $channel->{MsgTime} = time;
  }

  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"
  );

  for my $output (@intro) {
    Say( $self, $event->nick, $output );
  }
}


sub command_for_me ($$$$$) {
  my($self, $event, $channel_name, $command, $is_private)=@_;
  my $from_nick=$event->nick;
  my $dest_nick=($is_private ? $from_nick : $event->to);

# Workaround to enable private responses to commands issued in public
# channels
#   my $channel=  $is_private ? undef # Channel_by_nick($from_nick)
#       			   : Channel_by_name($channel_name);

  my $channel = Channel_by_name($channel_name);

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

  my $output='';

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

  if($valid_password) {

    # please quit
    if($command=~ /^(?:please\s+|pls\s+)?(?:quit|finish|terminate|die die die|exterminate)$/i) {
      $::Departing=1;
      for my $channel (@::Channels) {
	  $self->me($channel->{NAME}, 'is departing');
	  sleep(1);
      }
      # Log who told me to quit
      log_admin_event($self, $event, time, "$::Nick told to quit");
      $self->quit;
      unlink $::PID_File;
      exit(0);
    }
  
    # please announce xxxx
    if($command=~ /^(?:please\s+|pls\s+)?((?:announce|remark|whisper))\s+(.*)$/i) {
      my $aloud = $1 eq 'announce';
      my $message = $2;
      do_announce( $self, $message, $aloud );
      Say( $self, $dest_nick, 'done' );
      return;
    }

    # restart
    if($command eq 'restart') {
      $::Departing=1;
      Say($self, $event->to, ' is departing', 0 );
      $self->quit;
      sleep(1);
      $::Connecting=1;
      $self->connect();
      return;
    }
  
    # debug
    if($command eq 'debug') {
      Say( $self, $dest_nick, "Debugging is on" );
      $self->debug(1);
      return;
    }
    
    # nodebug
    if($command eq 'nodebug') {
      Say( $self, $dest_nick, "Debugging is off" );
      $self->debug(0);
      return;
    }

    # are you busy?
    if($command =~ /^(?:are you\s+)?(?:busy\?)/i) {
      my ($where, $idle);
      for my $channel (@::Channels) {
	  if ($channel->{Listening}) {
	      $where .= ' '.$channel->{NAME};
	      $idle .= ' '.$channel->{NAME}.':'
		    .int ((time - $channel->{MsgTime} + 30)/60);
	  }
      }
      Say( $self, $dest_nick,
		     $where ? "I'm listening on$where"
			    : "no, $from_nick, I'm not listening anywhere" );
      Say( $self, $dest_nick, 'Idle mins:'.$idle ) if $idle;
      return;
    }
  }
  
  # please excuse us
  if($::Do_Invites && 
     $command=~ /^(?:please\s+|pls\s+)?(?:bye|part|excuse us|leave)/i) {
    if($command=~ /^(?:please\s+|pls\s+)?part\s+(\S*)\s*$/i && $1) {
	$channel_name = $1;
	$channel = Channel_by_name($channel_name);
    }
    unless ($channel) {
	Say( $self, $dest_nick, "I don't know what channel you might mean" );
	return;
    }
    if($::Do_Actions) {
      DisplayActionItems($self, $event, $channel, $from_nick, $dest_nick);
    }
    Perform( $dest_nick,
	     sub {
		# Log who told me to quit
		log_admin_event($self, $event, time, "$::Nick told to depart $channel_name");
		$self->part($channel_name);
		Channel_close_logs($channel);
		$channel->{Listening} = 0;
		for (my $index=0; $index <= $#::Channels; $index++) {
		    if ($::Channels[$index] == $channel) {
			splice(@::Channels, $index, 1);
			last;
		    }
		}
	    }
	  );
    return;
  }

  if($command=~ /^(?:be quiet|shut up|silence|sshush|stop|off|nolisten)/i) {
    unless ($channel) {
	Say( $self, $dest_nick, "I don't know what channel you might mean" );
	return;
    }
    if($channel->{Listening}) {
      Say( $self, $event->to, 'is not logging', 0 );
      # Log who turned me off
      log_admin_event($self, $event, time, "Logging turned off");
      $channel->{Listening}=0;
    } else {
      Say( $self, $event->to, 'is already not logging', 0 );
    }
    return;
  }
  
  if($command=~ /^(?:hello|log|listen|record|start|begin|on|listen)/i) {
    unless ($channel) {
	Say( $self, $dest_nick, "I don't know what channel you might mean" );
	return;
    }
    if(!$channel->{Listening}) {
      Say( $self, $event->to, 'is logging', 0 );
      # Log who turned me on
      log_admin_event($self, $event, time, "Logging turned on");
      $channel->{Listening}=1;
    } else {
      Say( $self, $event->to, 'is already logging', 0 );
    }
    return;
  }

  if($command=~ /^(?:sync)/i) {
    unless ($channel) {
	Say( $self, $dest_nick, "I don't know what channel you might mean" );
	return;
    }
    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";
    }
    Say( $self, $dest_nick, $output );
    log_event($self, $event, time, $output, $self->nick) unless $is_private;
    return;
  }

  # please ignore action items, please track action items
  if($::Do_Actions &&
     $command =~ /^(?:please\s+|pls\s+)?((?:ignore|track))\s+action(?:\s+item)?s$/i) {
      my $which = $1;
      if ($which eq 'ignore') {
	  $channel->{IgnoreActions} = 1;
      }
      else {
	  delete $channel->{IgnoreActions};
      }
      Say( $self, $dest_nick, "ok, $from_nick, I will $which action items" );
      return;
  }

  # what [are the] action[ item]s?
  # [please] show [the] action[ item]s?
  if ($::Do_Actions &&
      ($command =~ /^what(?:\s+are\s+the)?\s+action(?:\s+item)?s\?$/i ||
       $command =~ /^(?:please\s+|pls\s+)?(?:show|list)(?:\s+the)?\s+action(?:\s+item)?s$/i)
     ) {
      DisplayActionItems($self, $event, $channel, $from_nick, $dest_nick);
      return 1;
  }

  # [please] drop action nn
  if ($::Do_Actions &&
      $command =~ m/^(?:please\s+|pls\s+)?drop\s+action\s+(.*)$/) {
      $channel->{MsgTime} = time;
      if ($channel->{IgnoreActions}) {
	  Say( $self, $dest_nick, "I am ignoring action items, $from_nick" );
	  return 1;
      }
      if ($is_private) {
	  Say( $self, $dest_nick, "I will not do that one-on-one, $from_nick" );
	  return 1;
      }
      my $action = $1;
      my $actionitems = $channel->{ActionItems};
      if ($action !~ m/^\d+$/ || $action == 0) {
	  Say( $self, $dest_nick, 'I can only remove action items by number' );
	  return 1;
      }
      $action = $action - 1; # delete must be numeric
      if ($actionitems) {
	  if ($action <= $#{$actionitems}) {
	      $actionitems->[$action]->{Status} = $::ActionDropped;
	      ExportActionList( $channel );
	      Say( $self,
		   $dest_nick,
		   'removing action '.($action+1).', '.$actionitems->[$action]->{Topic}
		  );
	  }
	  else {
	      my $length = $#{$actionitems}+1;
	      Say( $self,
		   $dest_nick,
		   'I only see '.$length.' action item'.($length == 1 ? '' : 's')
		   );
	  }
      }
      else {
	  Say( $self, $dest_nick, 'I see no action items' );
      }
      return 1;
  }

  # [please] join <channel> [<password>]
  if ($::Do_Invites && 
      $command =~ m/^(?:please\s+|pls\s+)?join\s+(\S*)\s*(\S*)\s*$/) {
      my $channel_name = $1;
      my $channel_key = $2;
      print "join $channel_name $channel_key from $from_nick\n";
      log_admin_event($self, $event, time, "Join request for $channel_name from $from_nick");
      $self->join($channel_name, $channel_key);
      return 1;
  }

  if ($channel) {
      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)=();
    if ($::HelpURI) {
	@help=(
	       "More detailed help is available in $::HelpURI"
        );
    }
    @help=(@help,
      "Some of the commands I know are:",
      " silence     - Stop logging (also: stop, off, ...)",
      " listen      - Start logging (also: start, on, ...)",
      " excuse us   - Leave the channel (also: bye)",
      " grep [-i] [first-last|max] <perl regex>  - Search the logs",
      "   e.g. grep foo, grep 5 bar, grep -i things [case independent]",
      " bookmark    - Give the URI of the current log");
   @help=(@help,
      " show action items - give a list of ACTION: entries",
      " drop action n - remove entry [n] from the list of action items")
   if $::Do_Actions;
   @help=(@help,
      "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.");
    if($self->{LogURIPrefix} || $::Log_URI) {
      @help=(@help,
	     "The log is in ".($self->{LogURIPrefix} ? $self->{LogURIPrefix} : $::Log_URI));
    }
    @help=(@help,
      "Do $::Nick, adminhelp for help on administrative commands",
    );

    for my $output (@help) {
      Say( $self, $dest_nick, $output );
    }
    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",
      "  announce MSG - Sends message to all channels",
      "  busy         - Gives summary of channels being listened on",
      "These commands work only with the admin PASSWORD like this:",
      "/msg $::Nick password PASSWORD command'",
    );

    for my $output (@help) {
      Say( $self, $dest_nick, $output );
    }
    return;
  }

  if ($command =~ /^(?:grep|search for|find)\s+(.+)$/) {
    unless ($channel) {
	Say( $self, $dest_nick, "I don't know what channel you might mean" );
	return;
    }
    my $search=$1;
    my $flags='';
    my($first,$count)=(0,$::Max_Results);

    if($search=~ s/^-i\s+//) {
      $flags='(?i)';
    }

    if($search=~ s/^(\d+|\d+-\d+)\s+(?:things about\s+|)//) {
      my $arg=$1;
      $arg=1 if $arg eq "0"; # fix previous breakage

      if($arg=~ m%^(\d+)-(\d+)$%) {
	my $last;
	($first,$last)=($1,$2);
	$count=$last-$first+1;
	$count=1 if $count<0;
      } else {
        $count=$arg;
      }
    }

    my $orig_search=$search;

    # Only allow a few regexes

    # Remove (?...) blocks since they can do evals
    $search =~ s/\(\?[^)]+\)//g;
    # Remove backticks since they can run processes
    $search =~ s/\`//g;
    # Remove variable references
    $search =~ s/\$//g;
    # Quote '/'s
    $search =~ s%/%\\/%g;


    # Prefix with flags
    $search=$flags.$search;

    my(@lines)=Channel_get_log_lines($channel);

    my(@results);
    eval "\@results=grep(/$search/, \@lines)";
    if($!) {
      @results=();
      my $msg=$!; $msg=~ s/^ at .+$//;
      $output.=qq{ Sorry, search failed with error - $msg};
    } elsif (!@results) {
      $output.=qq{ Sorry, nothing found for '$orig_search'};
      $output.=qq{ (internally: "$search")} if $orig_search ne $search;
    } else {
      my $size=scalar(@results);
      my $pl=($size != 1) ? 's' : '';
      $output.=" I found $size answer$pl for '$orig_search'";

      my $last=$first+$count-1;
      $last=$size-1 if $last > $size-1;
      if($first !=0 || $last != $size-1) {
	$output.=" (showing $first...$last)";
      }
      Say( $self, $dest_nick, $output );

      # Set result nick to me
      $event->nick($::Nick);

      log_event($self, $event, time, $output) unless $is_private;

      my $count=0;
      for(my $i=$first; $i <= $last; $i++) {
	$output="$i) ".$results[$i];
	Say( $self, $dest_nick, $output );
	log_event($self, $event, time, $output) unless $is_private;
	$count++;
	last if $count > $::Max_Max_Results;
      }
      return;
    }
  } else {
    return if watch_significant_events($self, $event, $channel_name, $command, $is_private, 1);
    $output.="I don't understand '$command', $from_nick.  Try /msg $::Nick help";
  }

  Say( $self, $dest_nick, $output );
  log_event($self, $event, time, $output) unless $is_private;
}


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

# 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
  $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;
}


my %OutputQueue;		# {nick}->@{queue}
my $SayScheduled = 0;
my $OutputBytesPending = 0;	# total bytes we're expecting to write
my $nextNickInQueue;		# round-robin the queue

# Queued output to the irc server; this tries to avoid flooding the
# server with output requests and the liklihood that the server will
# kick us
#
# Accepts: $conn - connection
#	   $nick - the channel name or nick to be addresses
#	   $msg  - the text to send
#	   $addressed - (optional) boolean: 1 if privmsg, 0 if /me
sub Say {
    my ($conn, $nick, $msg, $addressed) = @_;
    my $to = ref($nick) eq "ARRAY" ? join('~', @{$nick}) : $nick;

    $addressed = 1 if not defined $addressed;

    my @queues = keys %OutputQueue;

    # when queue is empty, output immediately but set timer
    # safe time to next output depends on the size of this output text;
    # thanks to Hugo Haas for recommending the algorithm.

    my $msgLength = length($msg) + ($addressed ? 9 : 18);
    # 9 = length('PRIVMSG '),  18 = length('PRIVMSG :^AACTION ')

    if (! $SayScheduled) {
	if ($addressed) { $conn->privmsg($nick, $msg) }
	else { $conn->me($nick, $msg) }
	my $interval =  1 + int $msgLength/80;
	$conn->schedule($interval, \&_doSay);
	$SayScheduled++;
    }
    else {
	my $queue = \@{$OutputQueue{$to}->{queue}};
	push @$queue, [$conn, $nick, $msg, $addressed];
	$OutputBytesPending += $msgLength;
    }
}

# Perform an action after queued output has been drained
#
# Accepts: $nick - channel whose output queue must be drained first
#	   $proc - procedure to be called
sub Perform {
    my ($nick, $proc) = @_;

    unless (ref $proc eq 'CODE') {
	warn 'Second argument to Perform() is not a coderef';
	return;
    }

    my $to = ref($nick) eq "ARRAY" ? join('~', @{$nick}) : $nick;

    my @queues = keys %OutputQueue;

    # when queue is empty, call the procedure immediately

    if (! $SayScheduled) {
	$proc->();
    }
    else {
	my $queue = \@{$OutputQueue{$to}->{queue}};
	push @$queue, [$proc];
    }
}

sub _doSay {
    my ($conn) = @_;		# ignored

    my @nicks = keys %OutputQueue;
    my $nicksRemaining = $#nicks + 1;

    $SayScheduled = 0;		# assume we're done

    return unless $nicksRemaining;

    my $nickToOutput = $nextNickInQueue ? $nextNickInQueue : $nicks[0];
    my $interval = 1;		# time to next safe output

    my $queue = \@{$OutputQueue{$nickToOutput}->{queue}};
    if ( $#$queue >= 0) {
	my $conn = $$queue[0][0];
	if (ref($conn) eq "Net::IRC::Connection") {
	    my $nick = $$queue[0][1];
	    my $msg = $$queue[0][2];
	    my $addressed = $$queue[0][3];
	    shift @$queue;

	    # safe time to next output depends on the size of this output text;
	    # thanks to Hugo Haas for recommending part of the algorithm.

	    my $msgLength = length($msg) + ($addressed ? 9 : 18);
	    # 9 = length('PRIVMSG '),  18 = length('PRIVMSG :^AACTION ')

	    # the more output we have to do, the more likely it is that a
	    # slow client will cause our output queue in the server to build
	    # Therefore we add more penalty as a function of the number of
	    # bytes we expect to output
	    $interval = 1 + int ($msgLength/($OutputBytesPending > 320 ? 60 : 100));

	    if ($addressed) { $conn->privmsg($nick, $msg) }
	    else { $conn->me($nick, $msg) }

	    $OutputBytesPending -= $msgLength;
	}
	else { # it's an action to perform, now that channel output is drained
	    shift @$queue;
	    $conn->();
	}
    }

    if ($#$queue < 0) {
	delete $OutputQueue{$nickToOutput};
	$nicksRemaining--;
    }

    if ($nicksRemaining) {
	# repeat until queue is drained
	$conn->schedule($interval, \&_doSay) if !$SayScheduled++;
    }

    my $next = 1;
    for my $nick (@nicks) {
	last if $nick eq $nickToOutput;
	$next++;
    }

    $nextNickInQueue = $nicks[$next];
}

sub do_announce
{
    my ($conn, $message, $first_person) = @_;
    for my $channel (@::Channels) {
	Say( $conn, $channel->{NAME}, $message, $first_person );
    }
}

sub AdminNotice
{
    my ($message) = @_;
    Say( $AdminChannel->{CONN}, $AdminChannel->{NAME}, $message)
	if $AdminChannel->{Listening};
}

# on forced disconnect, report what channels had output for debugging
sub log_pending_output($)
{
    my ($self) = @_;
    my @queuedNicks = keys %OutputQueue;
    my $msg;
    if ($#queuedNicks == -1) {
	$msg = "no output is queued.  $OutputBytesPending bytes pending.";
    }
    else {
	$msg = "total of $OutputBytesPending bytes pending for ";
	my $sep = '';
	for my $nick (@queuedNicks) {
	    my $Qentry = @{$OutputQueue{$nick}->{queue}}[0];
	    my $to = @{$Qentry}[1];
	    $msg.=$sep.(ref($to) eq "ARRAY" ? join('~', @{$to}) : $to);
	    $sep = ', ';
	}
    }
    log_admin_event($self, undef, time, $msg);
}

# Looks for messages to which to respond that are not directly addressed
# to the bot.
#
# Returns 0 if no such message was found, else 1
sub watch_significant_events ($$$$$$) {
    my($self, $event, $channel_name, $msg, $is_private, $addressed)=@_;
    my $from_nick=$event->nick;
    my $channel= $is_private ? undef # Channel_by_nick($from_nick)
			     : Channel_by_name($channel_name);

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

    return 0 if !$channel;

    return if !$::Do_Actions;

    # ACTION:
    if ($msg =~ m/^\s*(?:ACTION\s*)([-:])\s*(.*)$/) {
	$channel->{MsgTime} = time;
	if ($channel->{IgnoreActions}) {
	    Say( $self, $dest_nick, "I am ignoring action items, $from_nick", 1 )
		if $addressed;
	    return 1;
	}
	if ($is_private) {
	    Say( $self, $dest_nick, "I will not do that one-on-one, $from_nick", 1 );
	    return 1;
	}
	my $what = $1;
	my $add = $what eq ':';
	my $actionitems = $channel->{ActionItems};
	if ($add) {
	    my $topic = $2;
	    my $action = {};
	    $action->{Topic} = $topic;
	    if ($channel->{Last_ID}) {
		$action->{Pointer} = $channel->{LogURIPrefix}.'#'.$channel->{Last_ID}
	    }
	    if ($actionitems) {
		push(@{$actionitems}, $action);
	    } else {
		$actionitems = [$action];
		$channel->{ActionItems} = $actionitems;
	    }
	    my $count = $#{$actionitems} + 1;
	    $action->{id} = $count;
	    ExportActionList($channel);
	    Say( $self,
		 $dest_nick,
		 ($addressed ? '' : 'records ').'action '.$count,
		 $addressed
	       );
	}
	else {
	    my $actionID = $2;
	    if ($actionID !~ m/^\d+$/ || $actionID == 0) {
		if ($addressed) {
		    Say( $self,
			 $dest_nick,
			 'I can only remove action items by number',
			 1
			);
		}
		return 1;
	    }
	    $actionID = $actionID - 1; # delete must be numeric
	    if ($actionitems) {
		if ($actionID <= $#{$actionitems}) {
		    $actionitems->[$actionID]->{Status} = $::ActionDropped;
		    ExportActionList($channel);
		    Say( $self,
			 $dest_nick,
			 ($addressed ? 'dropping' : 'drops').' action '.($actionID+1).', '.$actionitems->[$actionID]->{Topic},
			 $addressed
			);
		}
		elsif ($addressed) {
		    my $length = $#{$actionitems}+1;
		    Say( $self,
			 $dest_nick,
			 'I only see '.$length.' action item'.($length == 1 ? '' : 's').', '.$from_nick,
			 1
			);
		}
	    }
	    else {
		Say( $self,
		     $dest_nick,
		     ($addressed ? 'I see' : 'sees').' no action items',
		 $addressed
	       );
	    }
	}
	return 1;
    }

    # action nnn = xxx
    if ($msg =~ m/^\s*(?:ACTION)\s*([0-9]*)\s*=\s*(.*)$/) {
	$channel->{MsgTime} = time;
	if ($channel->{IgnoreActions}) {
	    Say( $self, $dest_nick, "I am ignoring action items, $from_nick", 1 )
		if $addressed;
	    return 1;
	}
	if ($is_private) {
	    Say( $self, $dest_nick, "I will not do that one-on-one, $from_nick", 1 );
	    return 1;
	}
	my $which = $1;
	my $action = {};
	$action->{Topic} = $2;
	if ($channel->{Last_ID}) {
	    $action->{Pointer} = $channel->{LogURIPrefix}.'#'.$channel->{Last_ID}
	}
	my $actionitems = $channel->{ActionItems};
	if ($which == 0) {
	    if ($addressed) {
		Say( $self,
		     $dest_nick,
		     'I can only replace action items by number',
		     1
		    );
	    }
	    return 1;
	}
	$which = $which - 1; # index must be numeric
	if ($action) {
	    if ($which <= $#{$actionitems}) {
		$actionitems->[$which]->{Topic} = $action->{Topic};
		ExportActionList($channel);
		Say( $self,
		     $dest_nick,
		     ($addressed ? '' : 'records ').'action '.($which+1).' replaced',
		     $addressed
		    );
		}
	    elsif ($addressed) {
		my $length = $#{$actionitems}+1;
		Say( $self,
		     $dest_nick,
		     'I only see '.$length.' action item'.($length == 1 ? '' : 's'),
		     1
		     );
	    }
	}
	else {
	    Say( $self,
		 $dest_nick,
		 ($addressed ? 'I see' : 'sees').' no open action items',
		 $addressed
		);
	}
	return 1;
    }
}

sub ReapIdleChannels($)
{
    my ($conn) = @_;

    for (my $index=0; $index <= $#::Channels; $index++) {
	# have to use indexed-for since we intend to modify the array
	my $channel = $::Channels[$index];
	if ($channel->{Listening} && $channel != $AdminChannel) {
	    # if nothing interesting has been heard from the channel in 2 hours
	    if ((time - $channel->{MsgTime}) > $ReaperThreshold) {
		log_admin_event($conn, undef, time, "$::Nick auto-departing $channel->{NAME}");
		print "Auto-departing '$channel->{NAME}'\n";
		$conn->me($channel->{NAME}, 'excuses himself; his presence no longer seems to be needed');
		$conn->part($channel->{NAME});
		Channel_close_logs($channel);
		$channel->{Listening} = 0;
		splice(@::Channels, $index, 1);
		redo;		# restart w/o incrementing
	    }
	}
    }
    $ReaperScheduled = 0;
}


sub DisplayActionItems($$$$$)
{
    my ($self, $event, $channel, $from_nick, $dest_nick) = @_;
    $channel->{MsgTime} = time;
    my $nick = $self->nick;
    if ($channel->{IgnoreActions}) {
	my $msg = "I am ignoring action items, $from_nick";
	Say( $self, $dest_nick, $msg );
	log_event($self, $event, time, $msg, $nick);
	return 1;
    }
    my $actionitems = $channel->{ActionItems} ? $channel->{ActionItems} : [];
    my $actionCount = $#{$actionitems} + 1;
    if ($actionCount) {
	$actionCount = 0;	# count the number of still-open actions
	for my $action (@{$actionitems}) {
	    $actionCount++ unless $action->{Status} && $action->{Status} eq $::ActionDropped;
	}
    }
    if ($actionCount == 0) {
	my $msg = 'I see no action items';
	Say( $self, $dest_nick, $msg );
	log_event($self, $event, time, $msg, $nick);
	return 1;
    }
    my $msg = 'I see '.$actionCount.' open action item'.($actionCount == 1 ? '' : 's').':';
    Say( $self, $dest_nick, $msg );
    log_event($self, $event, time, $msg, $nick);
    for my $action (@{$actionitems}) {
	next if $action->{Status} && $action->{Status} eq $::ActionDropped;
	$msg = 'ACTION: '.$action->{Topic}.' ['.$action->{id}.']';
	Say( $self, $dest_nick, $msg );
	log_event($self, $event, time, $msg, $nick);
	if ($action->{Pointer}) {
	    $msg = '  recorded in '.$action->{Pointer};
	    Say( $self, $dest_nick, $msg );
	    log_event($self, $event, time, $msg, $nick);
	}
    }
}


sub ExportActionList($)
{
    my ($channel) = @_;
    my $docname;

    unless ($docname = $channel->{ActionLog}) {
	if ($::ActionLogName_Pattern) {
	    $docname = strftime( $::ActionLogName_Pattern, gmtime );
	}
	else {
	    $docname = strftime( $::Default_ActionPattern, gmtime );
	    my $log_dir=Channel_get_log_dir($channel);

	    if(!-d $log_dir) {
	      mkpath([$log_dir], 0, 0755);
	      # Failed!
	      if (! -d $log_dir) {
		log_admin_event($channel, undef, time, "Failed to create chat log dir $log_dir - $!");
		unlink $::PID_File;
		return;
	      }
	    }
	}

	{
	    my $channel_name = $channel->{NAME};
	    $channel_name =~ s/^[#&]//;

	    $docname =~ s/<channel>/$channel_name/;
	}

	my $ECHO = $::TestMode ? 'echo ' : '';
	system(("${ECHO}sh -c 'cd $::Log_LocalPath; cvs add $docname &'"));

	$channel->{ActionLog} = $docname;
	$channel->{CVSFiles} = ($channel->{CVSFiles} || '').$docname;
    }

    unless (open( ACTIONS, ">".($::Log_LocalPath || './').$docname)) {
	print 'Failed to open '.($::Log_LocalPath || './').$docname."\n";
	return 0;
    }

    my $progname = basename(__FILE__);
    my $CVSRevision = '$Revision: 1.4 $'; # capture CVS info here
    $CVSRevision =~ s/\$//g;	# drop '$' for W3C site repository checkin

    my $datetime = strftime( '%Y-%m-%dT%H:%MZ', gmtime );
    my $mtgRecord = xml_escape($channel->{LogURIPrefix} || $::Log_URI);

    print ACTIONS <<"EOT";
<?xml version="1.0" encoding="UTF-8"?>
<?xml-stylesheet type="text/css" href="http://www.w3.org/2002/07/actionlist-style.css" ?>
<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
         xmlns:dc="http://purl.org/dc/elements/1.1/"
         xmlns:m="http://www.w3.org/2002/07/meeting#">

<rdf:Description rdf:about="">
  <dc:date>$datetime</dc:date>
  <dc:title>Action Items from $mtgRecord</dc:title>
  <dc:creator>$::Nick $progname $CVSRevision</dc:creator>
</rdf:Description>

<rdf:Description rdf:about="$mtgRecord">
  <m:ActionList>
    <rdf:Seq>
EOT

    my $actionitems = $channel->{ActionItems} ? $channel->{ActionItems} : [];
    if ($#{$actionitems} >= 0) {
	for my $action (@{$actionitems}) {
	    print ACTIONS
'      <li><m:ActionItem rdf:about="#',$action->{id},'">
        <dc:title>',xml_escape($action->{Topic}),'</dc:title>';
	    print ACTIONS '
        <m:status>',$action->{Status},'</m:status>' if $action->{Status};
	    print ACTIONS '
        <dc:source rdf:resource="',xml_escape($action->{Pointer}),'"/>'
		if $action->{Pointer};
	    print ACTIONS '
        </m:ActionItem></li>
';
	}
    }

    print ACTIONS
'    </rdf:Seq>
  </m:ActionList>
</rdf:Description>

</rdf:RDF>
';

    close ACTIONS;
    return 1;
}


# The documentation starts here.  Perl allows use of this area
# via the special file handle DATA
__DATA__

=pod

=head1 NAME

logger - IRC Chat Logger

=head1 SYNOPSIS

  logger [options...] PASSWORD CHANNEL-URI

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

and options are:

 main options:
  -admin PATH    Directory for administrative logs and PID files
  -helpuri URI   specifies the name of a more detailed help document
  -cvs           commit logs to CVS; -lroot PATH must be specified
  -idleparttime SEC  leave ('part') a channel if it has been quite for more
                     than SEC seconds.  If s==0 (the default), do not leave.
  -log PATTERN   Name pattern for log files; uses strftime() substitutions,
                 '<channel>' will be replaced with the channel name.
                 Default is <channel>/%Y-%m-%d
                 (".txt", ".html", and ".rdf" will be appended)
  -lroot PATH    Write logs to PATH concat PATTERN (from -log PATTERN)
                 '<server>' in PATH will be replaced with host:port
		 Default is <server>/
  -nick NICK     Use IRC nick NICK
  -uroot URI     URI prefix for logs; '/' is not automatically added
                 '<server>' will be replaced with host:port

 simple on/off options:
  -actions       Track action items
  -html          Write an XHTML log as well as text and RDF
  -noinvites     Do not allow invite command
  -noinitiallog  Do not log the initial channel (specified in CHANNEL-URI)
  -nome          Do not log /me messages (WAS -noaction in logger 1.76)
  -noofftopic    Do not ignore lines starting with [off]
  -notext        Do not write a text log
  -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?

Logger also can perform searches over the logs using the
C<find> or C<grep> command (or ending anything to logger
with C<?>). It returns matches to the given perl regex in
recent output, most recent first. See the help text for more details.
Selected results can be returned by prefixing the command with a
count or a range like this:
  /msg logger grep 5 things
  /msg logger grep 10-20 things

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