#!/usr/bin/speedy -w
#!/usr/bin/perl -w
# Remove the top line if SpeedyCGI is not installed

use strict;
use CGI;
use URI::Escape;
use SafeIO;
use FileHandle;

use vars qw($root $output $chatdir $wwwchatdir $logfile $chatsuffix $settingssuffix %userdata $FS1 $q
 @speech %presence $id $channel $wwwchannel $settingsfile %settings $time $channelname
 $cookiename $wikidata
);
# --------------------------------------------------------

$chatdir = 'chat/'; # location on server, relative to current dir, where channel data is stored
$wwwchatdir = '/wiki/chat/'; # URL, relative to client's URL, where the channel XML data is visible
$logfile = 'log/chat.log'; # location on server, relative to current dir, where the log is placed
$chatsuffix = '.xml'; # filename suffix for channel data files
$settingssuffix = '.settings'; # filename suffix for channel settings files
$cookiename = 'ToothyWiki'; # name of wiki cookie for retrieving usernames
$wikidata = 'data/'; # location on server, relative to current dir, where wiki database resides
$wwwchannel = 'chat.pl'; # web-visible name of this script

# To activate a channel, create a file (channelname).xml in 
# the channel data dir. "chat" is the default name the client will look for.
# The script will search for settings in (channelname).settings, 
# followed by default.settings; if neither exist in the channel data dir,
# and also for settings they don't supply, the defaults below will be used:

%settings = 
( 
 maxretain => 30, # number of lines to retain on server per channel
 maxsize => 3990, # maximum amount of data to retain on server per channel
 presencetimeout => 11000, # ms (currently unused)
 statictimeout => 1200, # ms, shortest permissible time between polls to the server
 log => 1 # whether to log the channel
);

# The settings files contain lines of the form setting = value
# where setting is the name of one of the above settings.

# --------------------------------------------------------
%userdata = ( );
$root = 'chat';
$output = '';
$FS1 = "\xb3" . "1";

# --------------------------------------------------------
$q = new CGI;
print $q->header( -type=>'text/xml' );
print <<END
<?xml version="1.0"?>
END
;

# --------------------------------------------------------

@speech = ( );
%presence = ( );
$id = 0;
$channel = $q->param('channel');
$settingsfile = 'chat/default'.$settingssuffix;

$time = time;
$channelname = '';

if( defined($channel) )
{
	$channel =~ s/[^A-Za-z0-9_-]//g;
	$wwwchannel = $wwwchatdir . $channel . $chatsuffix;
	$channelname = $channel;
	$settingsfile = $chatdir . $channel . $settingssuffix;
	$channel = $chatdir . $channel . $chatsuffix;
	if( ! ( -f $channel ) )
	{
		$channel = undef;
	}
        if( -f $settingsfile )
	{
	  my $s = `cat $settingsfile`;
	  $s =~ s/[\n ]+/ /g;
	  foreach my $sl ( split / /, $s )
	  {
	    $sl =~ /^(.+)=(.*)$/ and $settings{$1}=$2; 
	  }
	}
}

if( defined($channel) )
{
	my $s = $q->param('say');
	if( defined($s) )
	{
		$s = uri_unescape($s);
		&GetUserData();
		if($s =~ /^\/me (.+)$/i)
		{
			$s = $userdata{'id'} . ' ' . $1;
		}
		else
		{
			$s = $userdata{'id'} . ': ' . $s;
		}
		$s = QuoteHTML($s);
		if($settings{log})
		{
		 ObtainLock( $logfile );
		 my $fh = new FileHandle( '>> ' . $logfile );
		 print $fh '<div class="entry">';
		 print $fh '<span class="channel">' . $channelname . '</span>';
		 my $ls = $s;
		 $ls =~ s/\&amp;/\&/g;
		 print $fh '<span class="data">' . $ls . '</span>';
		 print $fh '</div>';
		 $fh->close();
		 ReleaseLock( $logfile );
		}
	}

	ObtainLock( $channel );
	my $fh = new FileHandle;
	$fh->open( '< ' . $channel );
	while( <$fh> )
	{
		my $line = $_;
		$line =~ s/[\r\n]//g;

		if($line =~ /^say\(([0-9]+),.+$/)
		{
			if( $id < $1 )
			{
				$id = $1;
			}
			push @speech, [$1, $line];
		}
	}
	$fh->close();

	if( defined($s) )
	{
		$id++;
		$s = 'say(' . $id . ',"' . $s . '");';
		push @speech, [$id, $s];
		if( $#speech > $settings{maxretain} )
		{
			splice(@speech, 0, $#speech - $settings{maxretain})
		}
		while( ($#speech > -1) 
		       && (length(join('', map {$_->[1]} @speech )) > $settings{maxsize})
		     )
		{
		   shift @speech;
		}
		$fh->open( '> ' . $channel );
		print $fh '<?xml version="1.0"?>' . "\n";
		print $fh '<'.$root.'>' . "\n";
		foreach my $line( @speech )
		{
			print $fh $line->[1] . "\n";
		}
		print $fh '</'.$root.'>' . "\n";
		$fh->close();
	}

	ReleaseLock( $channel );

	my $minid = 0;
	if( $q->param('minid') && ($q->param('minid') =~ /([0-9]+)/) )
	{
		$minid = $1;
	}

	foreach my $line( @speech )
	{
		if( $line->[0] >= $minid )
		{
			$output .= $line->[1];
		}
	}
	$output .= 'setupdates( "' . $wwwchannel . '", ' . $settings{'statictimeout'} . ' );' . "\n";
}
else
{
	foreach my $channel( glob $chatdir . '*' . $chatsuffix )
	{
	  if( $channel =~ /$chatdir(.+)$chatsuffix/ )
		{
			$output .= 'channel("' . $1 . '");' . "\n";
		}
	}
}


# --------------------------------------------------------
print '<'.$root.'>'.$output.'</'.$root.'>';



# --------------------------------------------------------
# --------------------------------------------------------
# --------------------------------------------------------
# --------------------------------------------------------

sub QuoteHTML
{
  my( $s ) = @_;

  $s =~ s/\n/ /g;
  # $s =~ s/([^0-9A-Za-z _\(\)\[\~\]\:\;\.\,\!\?-])/sprintf("&amp;#%x;",ord($1))/ge;
  $s =~ s/([^0-9A-Za-z _\(\)\[\~\]\:\;\.\,\!\?-])/sprintf("&amp;#%d;",ord($1))/ge;

  return $s;
}

sub GetFileName
{
  my ($id) = @_;
  if( defined($id) and ($id=~ /^[0-9]*([0-9])$/) )
  {
    return $wikidata.'user/' . $1 . '/' . $id;
  }
  else
  {
    return undef;
  }
}

sub ReadDataFile
{
  my ($id) = @_;
  my $udata = { };

  my $fileName = &GetFileName($id);
#  $udata->{'username'} = $fileName;

  if( $fileName && ( -f $fileName . '.db' ) )
	{
		local $/ = undef;   # Read complete files

		if (open(IN, '<'.$fileName. '.db')) 
		{
			my $data=<IN>;
			close IN;
			my %data = split(/$FS1/, $data, -1);
			$udata = \%data;  # -1 keeps trailing null fields
		}
	}
	return $udata;
}

sub GetUserData
{
  my $ip = GetRemoteHost(1);
  my %cookie = $q->cookie($cookiename);
  my $id = $ip;

  if (($cookie{'id'}) and ($cookie{'id'} >= 1000))
  {
    $id = 'Wiki user ' . $cookie{'id'};
		$userdata{'udata'} = ReadDataFile($cookie{'id'});
		$userdata{'udata'}->{'username'} and $id = $userdata{'udata'}->{'username'};
    $userdata{'cookie'} = \%cookie;
  }
	else
	{
		$userdata{'cookie'} = { };
	}

  $userdata{'id'} = $id;
}