Index: openacs.org-dev/packages/irc-logger/ChangeLog
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/ChangeLog,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/ChangeLog 30 Jan 2003 00:14:01 -0000 1.1
@@ -0,0 +1,5 @@
+2003-01-29 Bart Teeuwisse <bart.teeuwisse@7-sisters.com>
+
+ * irc-logger.info (Module): Initial revision
+ (Module): Bumped up revision to 1.0b (beta)
+
Index: openacs.org-dev/packages/irc-logger/irc-logger.info
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/irc-logger.info,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/irc-logger.info 30 Jan 2003 00:14:01 -0000 1.1
@@ -0,0 +1,52 @@
+<?xml version="1.0"?>
+<!-- Generated by the OpenACS Package Manager -->
+
+<package key="irc-logger" url="http://openacs.org/repository/apm/packages/irc-logger" type="apm_application">
+ <package-name>IRC Logger</package-name>
+ <pretty-plural>IRC Loggers</pretty-plural>
+ <initial-install-p>f</initial-install-p>
+ <singleton-p>f</singleton-p>
+
+ <version name="1.0b" url="http://openacs.org/repository/download/apm/irc-logger-1.0b.apm">
+ <database-support>
+ <database>oracle</database>
+ <database>postgresql</database>
+ </database-support>
+ <owner url="mailto:bart.teeuwisse@thecodemill.biz">Bart Teeuwisse</owner>
+ <summary>The IRC logger places the log files of logger (a Perl script by Dave Beckett) into ETP for integration with OpenACS.</summary>
+ <vendor url="http://www.thecodemill.biz">the Code Mill</vendor>
+ <description format="text/html">The IRC logger places the log files of <a href="http://cvs.ilrt.org/cvsweb/redland/logger/">logger</a> (a Perl script by Dave Beckett) into ETP for integration with OpenACS. Besides logger, this package also depends on <a href="http://www.tdom.org/">tDOM</a> (high performance XML data processing with easy and powerful Tcl scripting functionality).</description>
+
+ <!-- No dependency information -->
+
+ <files>
+ <file path="data/default.xsl"/>
+ <file type="package_spec" path="irc-logger.info"/>
+ <file path="perl/logger"/>
+ <file type="tcl_init" path="tcl/irc-logger-init.tcl"/>
+ <file type="query_file" path="tcl/irc-logger-init.xql"/>
+ <file type="query_file" db_type="postgresql" path="tcl/irc-logger-procs-postgresql.xql"/>
+ <file type="tcl_procs" path="tcl/irc-logger-procs.tcl"/>
+ <file type="query_file" path="tcl/irc-logger-procs.xql"/>
+ <file type="query_file" db_type="postgresql" path="www/admin/index-postgresql.xql"/>
+ <file type="content_page" path="www/admin/index.adp"/>
+ <file type="content_page" path="www/admin/index.tcl"/>
+ <file type="query_file" path="www/admin/index.xql"/>
+ <file type="documentation" path="www/doc/index.adp"/>
+ <file type="documentation" path="www/doc/index.css"/>
+ <file type="documentation" path="www/doc/index.tcl"/>
+ <file type="documentation" path="www/doc/license.adp"/>
+ <file type="documentation" path="www/doc/license.tcl"/>
+ <file type="content_page" path="www/index.adp"/>
+ <file type="content_page" path="www/index.tcl"/>
+ <file type="query_file" path="www/index.xql"/>
+ </files>
+ <parameters>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="irc_channel_name" description="The name of the IRC channel being logged"/>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="xsl_stylesheet" description="The full path to the XSL stylesheet to be used to transform the RDF log into HTML"/>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="irc_rdf_dir" description="The full path to the directory containing the logger RDF files"/>
+ <parameter datatype="number" min_n_values="1" max_n_values="1" name="irc_log_interval" default="300" description="The interval (in seconds) with which IRC Logger should check for changes in the current RDF file."/>
+ </parameters>
+
+ </version>
+</package>
Index: openacs.org-dev/packages/irc-logger/data/default.xsl
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/data/default.xsl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/data/default.xsl 30 Jan 2003 00:14:19 -0000 1.1
@@ -0,0 +1,76 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0"
+ xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
+ xmlns="http://www.w3.org/TR/xhtml1/strict"
+ 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/">
+
+ <xsl:template match="foaf:ChatChannel">
+ <xsl:apply-templates/>
+ </xsl:template>
+
+ <xsl:template match="foaf:chatEventList">
+ <table>
+ <tbody>
+ <xsl:apply-templates/>
+ </tbody>
+ </table>
+ </xsl:template>
+
+ <xsl:template match="foaf:chatEvent">
+ <tr>
+ <td nowrap="true" valign="top">
+ <a name="{@rdf:ID}">
+ <xsl:apply-templates select="dc:date"/>
+ </a>
+ </td>
+ <xsl:apply-templates select="dc:creator/wn:Person"/>
+ <xsl:apply-templates select="dc:description"/>
+ </tr>
+ </xsl:template>
+
+ <xsl:template match="dc:date">
+ <font size="-1" color="grey"><xsl:value-of select="translate(.,'TZ',' ')"/> GMT</font>
+ </xsl:template>
+
+ <xsl:template match="dc:creator/wn:Person">
+ <td align="right" valign="top">
+ <font color="grey"><</font>
+ <b><xsl:value-of select="@foaf:nick"/></b>
+ <font color="grey">></font>
+ </td>
+ </xsl:template>
+
+ <xsl:template match="dc:description">
+ <td valign="top">
+ <xsl:choose>
+ <xsl:when test="contains(.,'has joined #openacs') or contains(.,'has left #openacs')">
+ <font color="grey"><xsl:value-of select="."/></font>
+ </xsl:when>
+ <xsl:when test="contains(.,'http:')">
+ <xsl:if test="contains(substring-after(.,'http:'),' ')">
+ <xsl:value-of select="substring-before(.,'http:')"/>
+ <a href="http:{substring-before(substring-after(.,'http:'),' ')}">http:<xsl:value-of select="substring-before(substring-after(.,'http:'),' ')"/></a>
+ <xsl:value-of select="concat(' ',substring-after(substring-after(.,'http:'),' '))"/>
+ </xsl:if>
+ <xsl:if test="not(contains(substring-after(.,'http:'),' '))">
+ <xsl:value-of select="substring-before(.,'http:')"/>
+ <a href="http:{substring-after(.,'http:')}">http:<xsl:value-of select="substring-after(.,'http:')"/></a>
+ </xsl:if>
+ </xsl:when>
+ <xsl:when test="starts-with(.,'*')">
+ <i><xsl:value-of select="substring-after(.,'* ')"/></i>
+ </xsl:when>
+ <xsl:when test="contains(.,'{') or contains(.,'}') or contains(.,'[') or contains(.,']')">
+ <pre><xsl:value-of select="."/></pre>
+ </xsl:when>
+ <xsl:otherwise>
+ <xsl:value-of select="."/>
+ </xsl:otherwise>
+ </xsl:choose>
+ </td>
+ </xsl:template>
+
+</xsl:stylesheet>
Index: openacs.org-dev/packages/irc-logger/perl/logger
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/perl/logger,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/perl/logger 30 Jan 2003 00:14:32 -0000 1.1
@@ -0,0 +1,2269 @@
+#!/usr/bin/perl -w
+#
+# IRC Chat Logger
+#
+# $Source: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/perl/logger,v $
+# $Id: logger,v 1.1 2003/01/30 00:14:32 daveb 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.1 2003/01/30 00:14:32 daveb 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.1 2003/01/30 00:14:32 daveb Exp $';
+ $progID =~ s/\$/\$/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/\$/$/g;
+ }
+ return $text;
+}
+
+sub xml_escape ($) {
+ my $string=shift;
+ $string =~ s/\&/\&/g;
+ $string =~ s/</\</g;
+ $string =~ s/>/\>/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.1 $'; # 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
Index: openacs.org-dev/packages/irc-logger/tcl/irc-logger-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/tcl/irc-logger-init.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/tcl/irc-logger-init.tcl 30 Jan 2003 00:14:44 -0000 1.1
@@ -0,0 +1,22 @@
+ad_library {
+
+ Schedule irc::logger::sheduled_update for each mounted instance
+ of irc-logger.
+
+ @creation-date 2003-01-27
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
+ @cvs-id $Id: irc-logger-init.tcl,v 1.1 2003/01/30 00:14:44 daveb Exp $
+
+}
+
+set package_key "irc-logger"
+db_foreach get_mounted_loggers {} {
+ ad_schedule_proc \
+ -debug f \
+ [parameter::get \
+ -package_id $package_id \
+ -parameter irc_log_interval \
+ -default 600] \
+ irc::logger::scheduled_update \
+ -package_id $package_id
+}
Index: openacs.org-dev/packages/irc-logger/tcl/irc-logger-init.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/tcl/irc-logger-init.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/tcl/irc-logger-init.xql 30 Jan 2003 00:14:44 -0000 1.1
@@ -0,0 +1,13 @@
+<?xml version="1.0"?>
+<queryset>
+
+ <fullquery name="get_mounted_loggers">
+ <querytext>
+ select package_id
+ from apm_packages p, site_nodes n
+ where p.package_key = :package_key
+ and n.object_id = package_id
+ </querytext>
+ </fullquery>
+
+</queryset>
Index: openacs.org-dev/packages/irc-logger/tcl/irc-logger-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/tcl/irc-logger-procs-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/tcl/irc-logger-procs-postgresql.xql 30 Jan 2003 00:14:44 -0000 1.1
@@ -0,0 +1,14 @@
+<?xml version="1.0"?>
+<queryset>
+
+ <rdbms>
+ <type>postgresql</type>
+ <version>7.1</version>
+ </rdbms>
+
+ <fullquery name="irc::logger::update_log.page_create">
+ <querytext>
+ select etp__create_page(:parent_package_id, :date, :date, :content_type)
+ </querytext>
+ </fullquery>
+</queryset>
Index: openacs.org-dev/packages/irc-logger/tcl/irc-logger-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/tcl/irc-logger-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/tcl/irc-logger-procs.tcl 30 Jan 2003 00:14:44 -0000 1.1
@@ -0,0 +1,220 @@
+ad_library {
+
+ Procs used by the irc-logger module.
+
+ @creation-date 2003-01-27
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
+ @cvs-id $Id: irc-logger-procs.tcl,v 1.1 2003/01/30 00:14:44 daveb Exp $
+}
+
+namespace eval irc::logger {
+
+ # The namespace of the irc-logger module
+
+}
+
+ad_proc -public irc::logger::get_log {
+ -date:required
+ -package_id:required
+} {
+
+ Check which .rdf file holds the current IRC log in RDF format as
+ created by Dave Beckett's logger.
+
+ @creation-date 2003-01-27
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
+
+ @param date The date in YYYY-MM-DD format to get the IRC log of.
+
+ @param package_id The package_id of the mounted IRC logger
+ instance to get the log for.
+
+ @return The full path to the IRC log in RDF format.
+
+ @error Return the empty string
+
+} {
+
+ # Locate the RDF log of the given date
+
+ foreach rdf_log [glob -nocomplain -directory [parameter::get \
+ -parameter irc_rdf_dir \
+ -package_id $package_id \
+ -default ""] $date.rdf] {
+ return $rdf_log
+ }
+
+ # Couldn't find the log, return the empty string.
+
+ return ""
+}
+
+ad_proc -public irc::logger::apply_xslt {
+ -rdf_log:required
+ -xsl_style:required
+} {
+
+ Transform the RDF IRC log to HTML using passed XSL stylesheet.
+
+ @creation-date 2003-01-27
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
+
+ @param rdf_log The full path to the IRC log in RDF format
+
+ @param xsl_style The full path to the XSL stylesheet to
+ transform the RDF log into HTML with.
+
+ @return The transformed IRC log in HTML.
+
+ @error Return the empty string.
+
+} {
+
+ # Parse the RDF log and the XSL style sheet into DOM trees.
+
+ if {![catch {set rdf [dom parse [read [open $rdf_log r]]]} error_msg]} {
+ if {![catch {set xsl [dom parse [read [open $xsl_style r]]]} error_msg]} {
+
+ # Transform the RDF DOM tree to an HTML DOM tree
+
+ if {![catch {set html [$rdf xslt $xsl]} error_msg]} {
+
+ # Serialize the HTML DOM tree as HTML text
+
+ return [$html asHTML]
+ $html delete
+
+ } else {
+ ns_log warning "irc::logger::apply_xslt - Could not transform RDF log '$rdf_log' to HTML with XSL sheet '$xsl_style': $error_msg"
+ }
+ $rdf delete
+ $xsl delete
+ } else {
+ ns_log warning "irc::logger::apply_xslt - Could not parse $xsl_style: $error_msg"
+ }
+ } else {
+ ns_log warning "irc::logger::apply_xslt - Could not parse $rdf_log: $error_msg"
+ }
+
+ # Return the empty string if the XSL style could not be applied.
+
+ return ""
+}
+
+ad_proc -public irc::logger::update_log {
+ -date:required
+ -package_id:required
+} {
+
+ Check the IRC log of the passed date associated with
+ package_id. Transform the RDF log to HTML if the log has changed
+ since the last time this proc was run. Then place the HTML log
+ in an ETP page of the ETP instance that IRC logger is mounted
+ under. The ETP page has the name of passed date.
+
+ @creation-date 2003-01-27
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
+
+ @param date The date in YYYY-MM-DD format to get the IRC log of.
+
+ @param package_id The package_id of the mounted IRC logger
+ instance to get the log for.
+
+ @return none
+
+ @error Write warning messages to the log were necessary.
+
+} {
+
+ # Check for an ETP parent node.
+
+ set logger_url [apm_package_url_from_id $package_id]
+ if {![empty_string_p $logger_url]} {
+ set parent_package_id [site_node::get_object_id \
+ -node_id [site_node::get_parent_id \
+ -node_id [site_node::get_node_id \
+ -url $logger_url]]]
+ set parent_package_key [apm_package_key_from_id $parent_package_id]
+ if {[string equal $parent_package_key "edit-this-page"]} {
+
+ # Get the RDF log for today.
+
+ set irc_rdf_log [irc::logger::get_log \
+ -date $date \
+ -package_id $package_id]
+ if {![empty_string_p $irc_rdf_log]} {
+
+ # Check if today's log has been modified.
+
+ if {[file mtime $irc_rdf_log] > [expr [clock seconds] - [parameter::get \
+ -parameter irc_log_interval \
+ -package_id $package_id \
+ -default 600]]} {
+
+ # Transform the RDF log to HTML.
+
+ set irc_html_log [irc::logger::apply_xslt \
+ -rdf_log $irc_rdf_log \
+ -xsl_style [parameter::get \
+ -parameter xsl_stylesheet \
+ -package_id $package_id \
+ -default "[acs_package_root_dir [apm_package_key_from_id $package_id]]/data/default.xsl"]]
+ if {![empty_string_p $irc_html_log]} {
+
+ # The transformation was succesful. Time to create
+ # or update the ETP page.
+
+ set irc_channel_name "[parameter::get \
+ -parameter irc_channel_name \
+ -package_id $package_id \
+ -default ""]"
+ set log_latest_revision_id [etp::get_latest_revision_id $parent_package_id $date]
+ if {[empty_string_p $log_latest_revision_id]} {
+
+ # Create a new ETP page for the log.
+
+ set content_type [etp::get_content_type]
+ db_exec_plsql page_create {}
+ }
+
+ # The update the existing ETP page for the log.
+
+ set log_live_revision_id [etp::get_live_revision_id $parent_package_id $date]
+ set log_description "Conversation log of $irc_channel_name of $date"
+ db_dml update_revision {}
+ }
+ }
+ }
+ } else {
+ ns_log warning "irc::logger::update_log - IRC logger $logger_url is not directly mounted under an ETP instance but rather $parent_package_key"
+ }
+ } else {
+ ns_log warning "irc::logger::update_log - IRC logger $package_id has been unmounted"
+ }
+}
+
+ad_proc -public irc::logger::scheduled_update {
+ -package_id:required
+} {
+
+ Scheduled procedure to check for updates of today's IRC log.
+
+ @creation-date 2003-01-27
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
+
+ @param package_id The package_id of the mounted IRC logger
+ instance to get the log for.
+
+ @return none
+
+ @error none
+
+} {
+ # The current log has the name of today's date in the GMT
+ # timezone.
+
+ set gmt_today [clock format [clock seconds] -format %Y-%m-%d -gmt true]
+ irc::logger::update_log \
+ -date $gmt_today \
+ -package_id $package_id
+}
Index: openacs.org-dev/packages/irc-logger/tcl/irc-logger-procs.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/tcl/irc-logger-procs.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/tcl/irc-logger-procs.xql 30 Jan 2003 00:14:44 -0000 1.1
@@ -0,0 +1,12 @@
+<?xml version="1.0"?>
+<queryset>
+
+ <fullquery name="irc::logger::update_log.update_revision">
+ <querytext>
+ update cr_revisions
+ set description = :log_description, content = :irc_html_log, mime_type = 'text/html'
+ where revision_id = :log_live_revision_id
+ </querytext>
+ </fullquery>
+
+</queryset>
Index: openacs.org-dev/packages/irc-logger/www/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/index.adp 30 Jan 2003 00:15:01 -0000 1.1
@@ -0,0 +1,16 @@
+<master>
+ <property name="title">@title@</property>
+
+ <table width="100%">
+ <tbody>
+ <tr>
+ <td align="right">
+ <if @admin_p@ eq 1>
+ [ <a href="admin/">Administer</a> ]
+ </if>
+ </td>
+ </tr>
+ </tbody>
+ </table>
+
+ <p>This package has no user pages.</p>
Index: openacs.org-dev/packages/irc-logger/www/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/index.tcl 30 Jan 2003 00:15:01 -0000 1.1
@@ -0,0 +1,34 @@
+ad_page_contract {
+
+ A place holder for access to the admin pages.
+
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
+ @creation-date 2003-01-29
+ @cvs $Id: index.tcl,v 1.1 2003/01/30 00:15:01 daveb Exp $
+
+} {
+} -properties {
+ title:onevalue
+}
+
+# Authenticate the user
+
+set user_id [ad_maybe_redirect_for_registration]
+
+# Check for admin privileges
+
+set package_id [ad_conn package_id]
+set admin_p [ad_permission_p $package_id admin]
+
+# Get the name of the package
+
+if {[db_0or1row get_package_name "
+ select p.instance_name
+ from apm_packages p, apm_package_versions v
+ where p.package_id = :package_id
+ and p.package_key = v.package_key
+ and v.enabled_p = 't'"]} {
+ set title "$instance_name"
+} else {
+ set title "IRC Logger"
+}
Index: openacs.org-dev/packages/irc-logger/www/index.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/index.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/index.xql 30 Jan 2003 00:15:01 -0000 1.1
@@ -0,0 +1,15 @@
+<?xml version="1.0"?>
+
+<queryset>
+
+ <fullquery name="get_package_name">
+ <querytext>
+ select p.instance_name
+ from apm_packages p, apm_package_versions v
+ where p.package_id = :package_id
+ and p.package_key = v.package_key
+ and v.enabled_p = 't'
+ </querytext>
+ </fullquery>
+
+</queryset>
Index: openacs.org-dev/packages/irc-logger/www/admin/index-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/admin/index-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/admin/index-postgresql.xql 30 Jan 2003 00:15:35 -0000 1.1
@@ -0,0 +1,32 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <partialquery name="transaction_last_24hours">
+ <querytext>
+ txn_attempted_time + '1 days'::interval > now()
+ </querytext>
+ </partialquery>
+
+ <partialquery name="transaction_last_week">
+ <querytext>
+ txn_attempted_time + '7 days'::interval > now()
+ </querytext>
+ </partialquery>
+
+ <partialquery name="transaction_last_month">
+ <querytext>
+ txn_attempted_time + '1 months'::interval > now()
+ </querytext>
+ </partialquery>
+
+<fullquery name="result_select">
+ <querytext>
+ select transaction_id, to_char(txn_attempted_time, 'MM-DD-YYYY HH24:MI:SS') as txn_time, txn_attempted_type, response, response_code, response_reason_code, response_reason_text, auth_code, avs_code, amount
+ from authorize_gateway_result_log
+ where '1'='1' [ad_dimensional_sql $dimensional] [ad_order_by_from_sort_spec $orderby $table_def]
+ </querytext>
+ </fullquery>
+
+</queryset>
\ No newline at end of file
Index: openacs.org-dev/packages/irc-logger/www/admin/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/admin/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/admin/index.adp 30 Jan 2003 00:15:35 -0000 1.1
@@ -0,0 +1,12 @@
+<master>
+ <property name="title">@title@</property>
+
+ <table width="100%">
+ <tbody>
+ <tr>
+ <td align="right">[ <a href="/doc/@package_key@/">help</a> ]</td>
+ </tr>
+ </tbody>
+ </table>
+
+ <p><a href="/admin/site-map/parameter-set?package_id=@package_id@">Set package parameters</a></p>
Index: openacs.org-dev/packages/irc-logger/www/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/admin/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/admin/index.tcl 30 Jan 2003 00:15:35 -0000 1.1
@@ -0,0 +1,36 @@
+ad_page_contract {
+
+ Provide a link to the package parameters of this instance of IRC
+ Logger.
+
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
+ @creation-date 2003-01-29
+ @cvs $Id: index.tcl,v 1.1 2003/01/30 00:15:35 daveb Exp $
+} {
+} -properties {
+ title:onevalue
+
+}
+
+# Authenticate the user
+
+set user_id [ad_maybe_redirect_for_registration]
+
+# Check for admin privileges
+
+set package_id [ad_conn package_id]
+set package_key [ad_conn package_key]
+set admin_p [ad_permission_p $package_id admin]
+
+# Get the package name and set the title.
+
+if {[db_0or1row get_package_name "
+ select p.instance_name
+ from apm_packages p, apm_package_versions v
+ where p.package_id = :package_id
+ and p.package_key = v.package_key
+ and v.enabled_p = 't'"]} {
+ set title "$instance_name Administration"
+} else {
+ set title "Administration"
+}
Index: openacs.org-dev/packages/irc-logger/www/admin/index.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/admin/index.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/admin/index.xql 30 Jan 2003 00:15:35 -0000 1.1
@@ -0,0 +1,14 @@
+<?xml version="1.0"?>
+<queryset>
+
+ <fullquery name="get_package_name">
+ <querytext>
+ select p.instance_name
+ from apm_packages p, apm_package_versions v
+ where p.package_id = :package_id
+ and p.package_key = v.package_key
+ and v.enabled_p = 't'
+ </querytext>
+ </fullquery>
+
+</queryset>
Index: openacs.org-dev/packages/irc-logger/www/doc/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/doc/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/doc/index.adp 30 Jan 2003 00:17:02 -0000 1.1
@@ -0,0 +1,166 @@
+<master>
+ <property name="title">@title@</property>
+ <property name="signatory">@signatory@</property>
+ <property name="context_bar">@context_bar@</property>
+ <property name="header_stuff"><link href="index.css" type="text/css" rel="stylesheet"></property>
+
+ <h2>Why</h2>
+
+ <p>@package_name@ was created to publish the conversation logs of
+ the <a href="irc::/irc.freenode.net/#openacs" title="Direct link to
+ the #openacs channel. Does not work in all browsers.">#openacs</a>
+ IRC channel at <a href="http://openacs.org" title="Home of the Open
+ Architecture Community System">OpenACS</a> in a way that allowed the
+ logs to be indexed and subject to the OpenACS permission system.</p>
+
+ <h2>Background</h2>
+
+ <p>While Dave Beckett's <a
+ href="http://cvs.ilrt.org/cvsweb/redland/logger/">IRC Chat
+ logger</a> also can generate a HTML log @package_name@ improves upon
+ Dave's logger in several ways:</p>
+
+ <ol>
+ <li>By transforming the RDF log to HTML one is free to create HTML logs in any format desired.</li>
+
+ <li>Once transformed to HTML the log is stored in an <a
+ href="http://openacs.org/doc/edit-this-page/">Edit-This-Page</a>
+ page which allows selective permissions on the log and
+ causes the log to be indexed by the site's search engine.</li>
+
+ <li>Furthermore placing the log in an Edit-This-Page page the
+ log encapsules the log with the master template of site.</li>
+
+ </ol>
+
+ <h2>Installation</h2>
+
+ <p class="note">Note: This release has been developed on PostgreSQL
+ only. Please report any problems you might find in the <a
+ href="http://openacs.org/bugtracker/">OpenACS bugtracker</a>. The
+ bugtracker can also be used to contribute patches to the
+ @package_name@ package (for example to add Oracle support).</p>
+
+ <p>The @package_name@ requires <a
+ href="http://www.tdom.org/">tDOM</a> and Edit-This-Page to be
+ installed. tDOM provides the XML parsing and XSLT capabilities
+ that @package_name@ relies upon. Please follow the installation
+ instructions included with tDOM. Edit-This-Page is another OpenACS
+ module and is available from <a
+ href="http://openacs.org/">OpenACS</a>.</p>
+
+ <p>Included with @package_name@ is a <i>modified</i> copy of Dave
+ Beckett's RDF IRC Chat Logger. Dave's Perl script has been
+ modified to allow the bot to respond in private to messages
+ originating in the public channel. The logger script is located in
+ the perl directory of @package_name@, type <code>./logger
+ --help</code> for a complete list of command line options.</p>
+
+ <p>During the development of @package_name@ <a
+ href="http://wwww.thecodemill.biz">the Code Mill</a> used the
+ following parameters to start logging</p>
+ <blockquote><pre><code>
+logger \
+-nick eavesdrop \
+-lroot /web/thecodemill/data/eavesdrop/log/ \
+-log %Y-%m-%d \
+-admin /web/thecodemill/data/eavesdrop/admin/ \
+-uroot "http://www.thecodemill.biz/irc/log/" \
+bla irc://irc.freenode.net/openacs
+ </code></pre></blockquote>
+
+ <p>Place logger under supervision using <a
+ href=="http://cr.yp.to/daemontools.html">daemontools</a> or crontab
+ to guarantee that the bot stays connected to the IRC channel it is
+ logging.</p>
+
+ <p class="note">Check this <a
+ href="http://groups.google.com/groups?q=irc+perl+connection.pm&hl=en&lr=&ie=UTF-8&oe=UTF-8&safe=off&selm=befb49b6.0106160819.201cabdf%40posting.google.com&rnum=3">usenet
+ message</a> should you be experiencing problems with the perl
+ package <a href="http://search.cpan.org/author/JEEK/Net-IRC-0.73/IRC.pm">Net::IRC</a> which logger depends on.</p>
+
+ <p>With tDOM installed and logger connected to the IRC channel it is
+ time to mount and configure @package_name@.</p>
+
+ <h2>Usage</h2>
+
+ <ol>
+ <li>Mount @package_name@ directly under an instance of
+ Edit-This-Page. E.g. if /irc/log/ is an instance of
+ Edit-This-Page then mount @package_name@ at /irc/log/logger/.</li>
+
+ <li>Configured @package_name@. Configuration is via <a
+ href="/admin/site-map/">@package_name@ parameters</a>. The package
+ has 4 parameters:
+
+ <ol>
+ <li>
+
+ <h3>irc_channel_name</h3>
+
+ <p>The name of the IRC channel being logged. This should match
+ the name of the IRC channel that the Perl logger script is
+ logging. E.g. #openacs</p>
+
+ </li>
+ <li>
+
+ <h3>xsl_stylesheet</h3>
+
+ <p>The full path to the XSL stylesheet to be used to transform
+ the RDF log into HTML. The default.xsl stylesheet in the data
+ directory of the @package_name@ package will be used if no
+ value is specified.</p>
+
+ </li>
+ <li>
+
+ <h3>irc_rdf_dir</h3>
+
+ <p>The full path to the directory containing the logger RDF
+ files. This is the directory that the Perl logger script writes
+ the RDF (and text) log files to. E.g. /web/thecodemill/data/eavesdrop/log/</p>
+
+ </li>
+ <li>
+
+ <h3>irc_log_interval</h3>
+
+ <p>The interval (in seconds) with which IRC Logger should
+ check for changes in the current RDF file. The default is
+ 300 seconds (or 5 minutes).</p>
+
+ </li>
+ </ol>
+ </li>
+ </ol>
+
+ <p>Last but not least, restart AOLserver to start scheduled
+ procedure <a
+ href="/api-doc/proc/irc::logger::scheduled_update">irc::logger::scheduled_update</a>
+ that checks for updates of today's IRC log and puts an
+ Edit-This-Page page of the log directly under the instance of
+ Edit-This-Page that @package_name@ is mounted under.</p>
+
+ <p>@package_name@ can be mounted more than once. Each instance processing the logs of a different bot.</p>
+
+ <h2>Credits</h2>
+
+ <p>The @package_name@ was designed and written by <a
+ href="mailto:bart.teeuwisse@thecodemill.biz">Bart Teeuwisse</a>
+ of <a href="http://www.thecodemill.biz">the Code Mill</a> for <a
+ href="http://openacs.org">OpenACS</a>.</p>
+
+ <p>The @package_name@ 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.</p>
+
+ <p>The @package_name@ 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.</p>
+
+ <p>A <a href="license">copy of the GNU General Public License</a> is
+ included. If not write to the Free Software Foundation, Inc., 59
+ Temple Place, Suite 330, Boston, MA 02111-1307 USA
Index: openacs.org-dev/packages/irc-logger/www/doc/index.css
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/doc/index.css,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/doc/index.css 30 Jan 2003 00:17:02 -0000 1.1
@@ -0,0 +1,5 @@
+p.note {
+ font-style: italic;
+ padding: 10;
+ background-color: lightgrey;
+}
Index: openacs.org-dev/packages/irc-logger/www/doc/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/doc/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/doc/index.tcl 30 Jan 2003 00:17:02 -0000 1.1
@@ -0,0 +1,26 @@
+ad_page_contract {
+
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
+ @creation-date 2003-01-29
+ @cvs $Id: index.tcl,v 1.1 2003/01/30 00:17:02 daveb Exp $
+
+} {
+} -properties {
+ title:onevalue
+ context_bar:onevalue
+}
+
+# Authenticate the user
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set package_name "IRC Logger"
+set title "$package_name Documentation"
+
+# Set the context bar.
+
+set context_bar [ad_context_bar $package_name]
+
+# Set signatory for at the bottom of the page
+
+set signatory "bart.teeuwisse@thecodemill.biz"
Index: openacs.org-dev/packages/irc-logger/www/doc/license.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/doc/license.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/doc/license.adp 30 Jan 2003 00:17:02 -0000 1.1
@@ -0,0 +1,317 @@
+<master>
+ <property name="title">@title@</property>
+ <property name="signatory">@signatory@</property>
+ <property name="context_bar">@context_bar@</property>
+ <property name="header_stuff"><link href="index.css" type="text/css" rel="stylesheet"></property>
+
+ <h2>GNU General Public License</h2>
+
+ <p>Version 2, June 1991</p>
+
+ <pre>
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+ </pre>
+
+ <h2>Preamble</h2>
+
+ <p>The licenses for most software are designed to take away your
+ freedom to share and change it. By contrast, the GNU General
+ Public License is intended to guarantee your freedom to share and
+ change free software--to make sure the software is free for all
+ its users. This General Public License applies to most of the
+ Free Software Foundation's software and to any other program whose
+ authors commit to using it. (Some other Free Software Foundation
+ software is covered by the GNU Library General Public License
+ instead.) You can apply it to your programs, too.</p>
+
+ <p>When we speak of free software, we are referring to freedom, not
+ price. Our General Public Licenses are designed to make sure that
+ you have the freedom to distribute copies of free software (and
+ charge for this service if you wish), that you receive source code
+ or can get it if you want it, that you can change the software or
+ use pieces of it in new free programs; and that you know you can
+ do these things.</p>
+
+ <p>To protect your rights, we need to make restrictions that forbid
+ anyone to deny you these rights or to ask you to surrender the
+ rights. These restrictions translate to certain responsibilities
+ for you if you distribute copies of the software, or if you modify
+ it.</p>
+
+ <p>For example, if you distribute copies of such a program, whether
+ gratis or for a fee, you must give the recipients all the rights
+ that you have. You must make sure that they, too, receive or can
+ get the source code. And you must show them these terms so they
+ know their rights.</p>
+
+ <p>We protect your rights with two steps: (1) copyright the
+ software, and (2) offer you this license which gives you legal
+ permission to copy, distribute and/or modify the software.</p>
+
+ <p>Also, for each author's protection and ours, we want to make
+ certain that everyone understands that there is no warranty for
+ this free software. If the software is modified by someone else
+ and passed on, we want its recipients to know that what they have
+ is not the original, so that any problems introduced by others
+ will not reflect on the original authors' reputations.</p>
+
+ <p>Finally, any free program is threatened constantly by software
+ patents. We wish to avoid the danger that redistributors of a
+ free program will individually obtain patent licenses, in effect
+ making the program proprietary. To prevent this, we have made it
+ clear that any patent must be licensed for everyone's free use or
+ not licensed at all.</p>
+
+ <p>The precise terms and conditions for copying, distribution and
+ modification follow.</p>
+
+ <h2>Terms and conditions for copying, distribution and modification</h2>
+
+ <p><strong>0.</strong> This License applies to any program or other
+ work which contains a notice placed by the copyright holder saying
+ it may be distributed under the terms of this General Public
+ License. The "Program", below, refers to any such program or
+ work, and a "work based on the Program" means either the Program
+ or any derivative work under copyright law: that is to say, a work
+ containing the Program or a portion of it, either verbatim or with
+ modifications and/or translated into another language.
+ (Hereinafter, translation is included without limitation in the
+ term "modification".) Each licensee is addressed as "you".</p>
+
+ <p>Activities other than copying, distribution and modification are
+ not covered by this License; they are outside its scope. The act
+ of running the Program is not restricted, and the output from the
+ Program is covered only if its contents constitute a work based on
+ the Program (independent of having been made by running the
+ Program). Whether that is true depends on what the Program does.</p>
+
+ <p><strong>1.</strong> You may copy and distribute verbatim copies
+ of the Program's source code as you receive it, in any medium,
+ provided that you conspicuously and appropriately publish on each
+ copy an appropriate copyright notice and disclaimer of warranty;
+ keep intact all the notices that refer to this License and to the
+ absence of any warranty; and give any other recipients of the
+ Program a copy of this License along with the Program.</p>
+
+
+ <p>You may charge a fee for the physical act of transferring a copy,
+ and you may at your option offer warranty protection in exchange
+ for a fee.</p>
+
+ <p><strong>2.</strong> You may modify your copy or copies of the
+ Program or any portion of it, thus forming a work based on the
+ Program, and copy and distribute such modifications or work under
+ the terms of Section 1 above, provided that you also meet all of
+ these conditions:</p>
+
+ <ul>
+
+ <li><p><strong>a)</strong> You must cause the modified files to carry
+ prominent notices stating that you changed the files and the
+ date of any change.</p></li>
+
+ <li><p><strong>b)</strong> You must cause any work that you
+ distribute or publish, that in whole or in part contains or is
+ derived from the Program or any part thereof, to be licensed as
+ a whole at no charge to all third parties under the terms of
+ this License.</p></li>
+
+ <li><p><strong>c)</strong> If the modified program normally reads
+ commands interactively when run, you must cause it, when started
+ running for such interactive use in the most ordinary way, to
+ print or display an announcement including an appropriate
+ copyright notice and a notice that there is no warranty (or
+ else, saying that you provide a warranty) and that users may
+ redistribute the program under these conditions, and telling the
+ user how to view a copy of this License. (Exception: if the
+ Program itself is interactive but does not normally print such
+ an announcement, your work based on the Program is not required
+ to print an announcement.)</p></li>
+ </ul>
+
+ <p>These requirements apply to the modified work as a whole. If
+ identifiable sections of that work are not derived from the
+ Program, and can be reasonably considered independent and separate
+ works in themselves, then this License, and its terms, do not
+ apply to those sections when you distribute them as separate
+ works. But when you distribute the same sections as part of a
+ whole which is a work based on the Program, the distribution of
+ the whole must be on the terms of this License, whose permissions
+ for other licensees extend to the entire whole, and thus to each
+ and every part regardless of who wrote it.</p>
+
+ <p>Thus, it is not the intent of this section to claim rights or
+ contest your rights to work written entirely by you; rather, the
+ intent is to exercise the right to control the distribution of
+ derivative or collective works based on the Program.</p>
+
+ <p>In addition, mere aggregation of another work not based on the
+ Program with the Program (or with a work based on the Program) on
+ a volume of a storage or distribution medium does not bring the
+ other work under the scope of this License.</p>
+
+ <p><strong>3.</strong> You may copy and distribute the Program (or
+ a work based on it, under Section 2) in object code or executable
+ form under the terms of Sections 1 and 2 above provided that you
+ also do one of the following:</p>
+
+ <ul>
+
+ <li><p><strong>a)</strong> Accompany it with the complete
+ corresponding machine-readable source code, which must be
+ distributed under the terms of Sections 1 and 2 above on a
+ medium customarily used for software interchange; or,</p></li>
+
+ <li><p><strong>b)</strong> Accompany it with a written offer,
+ valid for at least three years, to give any third party, for a
+ charge no more than your cost of physically performing source
+ distribution, a complete machine-readable copy of the
+ corresponding source code, to be distributed under the terms of
+ Sections 1 and 2 above on a medium customarily used for software
+ interchange; or,</p></li>
+
+ <li><p><strong>c)</strong> Accompany it with the information you
+ received as to the offer to distribute corresponding source
+ code. (This alternative is allowed only for noncommercial
+ distribution and only if you received the program in object code
+ or executable form with such an offer, in accord with Subsection
+ b above.)</p></li>
+ </ul>
+
+ <p>The source code for a work means the preferred form of the work
+ for making modifications to it. For an executable work, complete
+ source code means all the source code for all modules it contains,
+ plus any associated interface definition files, plus the scripts
+ used to control compilation and installation of the executable.
+ However, as a special exception, the source code distributed need
+ not include anything that is normally distributed (in either
+ source or binary form) with the major components (compiler,
+ kernel, and so on) of the operating system on which the executable
+ runs, unless that component itself accompanies the executable.</p>
+
+ <p>If distribution of executable or object code is made by offering
+ access to copy from a designated place, then offering equivalent
+ access to copy the source code from the same place counts as
+ distribution of the source code, even though third parties are not
+ compelled to copy the source along with the object code.</p>
+
+ <p><strong>4.</strong> You may not copy, modify, sublicense, or
+ distribute the Program except as expressly provided under this
+ License. Any attempt otherwise to copy, modify, sublicense or
+ distribute the Program is void, and will automatically terminate
+ your rights under this License. However, parties who have
+ received copies, or rights, from you under this License will not
+ have their licenses terminated so long as such parties remain in
+ full compliance.</p>
+
+ <p><strong>5.</strong> You are not required to accept this
+ License, since you have not signed it. However, nothing else
+ grants you permission to modify or distribute the Program or its
+ derivative works. These actions are prohibited by law if you do
+ not accept this License. Therefore, by modifying or distributing
+ the Program (or any work based on the Program), you indicate your
+ acceptance of this License to do so, and all its terms and
+ conditions for copying, distributing or modifying the Program or
+ works based on it.</p>
+
+ <p><strong>6.</strong> Each time you redistribute the Program (or any
+ work based on the Program), the recipient automatically receives a
+ license from the original licensor to copy, distribute or modify
+ the Program subject to these terms and conditions. You may not
+ impose any further restrictions on the recipients' exercise of the
+ rights granted herein. You are not responsible for enforcing
+ compliance by third parties to this License.</p>
+
+ <p><strong>7.</strong> If, as a consequence of a court judgment or
+ allegation of patent infringement or for any other reason (not
+ limited to patent issues), conditions are imposed on you (whether
+ by court order, agreement or otherwise) that contradict the
+ conditions of this License, they do not excuse you from the
+ conditions of this License. If you cannot distribute so as to
+ satisfy simultaneously your obligations under this License and any
+ other pertinent obligations, then as a consequence you may not
+ distribute the Program at all. For example, if a patent license
+ would not permit royalty-free redistribution of the Program by all
+ those who receive copies directly or indirectly through you, then
+ the only way you could satisfy both it and this License would be
+ to refrain entirely from distribution of the Program.</p>
+
+ <p>If any portion of this section is held invalid or unenforceable
+ under any particular circumstance, the balance of the section is
+ intended to apply and the section as a whole is intended to apply
+ in other circumstances.</p>
+
+ <p>It is not the purpose of this section to induce you to infringe
+ any patents or other property right claims or to contest validity
+ of any such claims; this section has the sole purpose of
+ protecting the integrity of the free software distribution system,
+ which is implemented by public license practices. Many people
+ have made generous contributions to the wide range of software
+ distributed through that system in reliance on consistent
+ application of that system; it is up to the author/donor to decide
+ if he or she is willing to distribute software through any other
+ system and a licensee cannot impose that choice.</p>
+
+ <p>This section is intended to make thoroughly clear what is
+ believed to be a consequence of the rest of this License.</p>
+
+ <p><strong>8.</strong> If the distribution and/or use of the Program
+ is restricted in certain countries either by patents or by
+ copyrighted interfaces, the original copyright holder who places
+ the Program under this License may add an explicit geographical
+ distribution limitation excluding those countries, so that
+ distribution is permitted only in or among countries not thus
+ excluded. In such case, this License incorporates the limitation
+ as if written in the body of this License.</p>
+
+ <p><strong>9.</strong> The Free Software Foundation may publish
+ revised and/or new versions of the General Public License from
+ time to time. Such new versions will be similar in spirit to the
+ present version, but may differ in detail to address new problems
+ or concerns.</p>
+
+ <p>Each version is given a distinguishing version number. If the
+ Program specifies a version number of this License which applies
+ to it and "any later version", you have the option of following
+ the terms and conditions either of that version or of any later
+ version published by the Free Software Foundation. If the Program
+ does not specify a version number of this License, you may choose
+ any version ever published by the Free Software Foundation.</p>
+
+ <p><strong>10.</strong> If you wish to incorporate parts of the
+ Program into other free programs whose distribution conditions are
+ different, write to the author to ask for permission. For
+ software which is copyrighted by the Free Software Foundation,
+ write to the Free Software Foundation; we sometimes make
+ exceptions for this. Our decision will be guided by the two goals
+ of preserving the free status of all derivatives of our free
+ software and of promoting the sharing and reuse of software
+ generally.</p>
+
+ <p><strong>NO WARRANTY</strong></p>
+
+ <p><strong>11.</strong> BECAUSE THE PROGRAM IS LICENSED FREE OF
+ CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT
+ PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN
+ WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE
+ PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR
+ IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE
+ RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.
+ SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+ NECESSARY SERVICING, REPAIR OR CORRECTION.</p>
+
+ <p><strong>12.</strong> IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW
+ OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER
+ PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED
+ ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL,
+ SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+ USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO
+ LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED
+ BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE
+ WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS
+ BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.</p>
Index: openacs.org-dev/packages/irc-logger/www/doc/license.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/www/doc/license.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs.org-dev/packages/irc-logger/www/doc/license.tcl 30 Jan 2003 00:17:02 -0000 1.1
@@ -0,0 +1,29 @@
+ad_page_contract {
+
+ License information of the Authorize.net Gateway, an
+ implementation of the Payment Service Contract.
+
+ @author Bart Teeuwisse <bart.teeuwisse@7-sisters.com>
+ @creation-date May 2002
+ @cvs $Id: license.tcl,v 1.1 2003/01/30 00:17:02 daveb Exp $
+
+} {
+} -properties {
+ title:onevalue
+ context_bar:onevalue
+}
+
+# Authenticate the user
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set package_name "IRC Logger"
+set title "$package_name License"
+
+# Set the context bar.
+
+set context_bar [ad_context_bar [list . $package_name] License]
+
+# Set signatory for at the bottom of the page
+
+set signatory "bart.teeuwisse@thecodemill.biz"