#cbhistory.cgi
#!/usr/bin/perl -w

# cbhistory is derived from cblast35 which was written by
# crazyinsomniac.

use strict;

use CGI qw¡:standard url *table *Tr *td¡;

   $CGI::DISABLE_UPLOADS = 1;# Disable uploads
   $CGI::POST_MAX        =-1;# Maximum number of bytes per post

use CGI::Carp q!fatalsToBrowser!;
use DBI;
use HTML::TokeParser;

use constant DB_CONNECT => 'dbi:Pg:dbname=chatter';
# this user needs SELECT rights on the chatter table
use constant DB_USER => 'username';
use constant DB_PASS => 'password';

my %allowed = ( a=>1, b=>1, br=>1, em=>1, i=>1, kbd=>1, s=>1, samp=>1,
		strike=>1, strong=>1, sub=>1, sup=>1, tt=>1, u=>1 );

# known chatterboxes
my %boxes = ( PM => { URL  => 'http://www.perlmonks.org/index.pl',
		      NAME => 'Perl Monks' },
	      JJ => { URL  => 'http://www.javajunkies.org/index.pl',
		      NAME => 'JavaJunkies' } );

my $html;
my $q = new CGI;

# D'loop Mayno
{
    $|=1;
    # ChatterboxXMLTicker
    my $box = param("site");
    my $plain = param("plain");
    my $url = $q->url(-relative=>1);
    if ( !$box || !exists($boxes{$box}) ) {
	$html = &show_available_boxes();
	$html .= &show_links();
    } else {
	my $dbh = DBI->connect(DB_CONNECT, DB_USER, DB_PASS,
			       {RaiseError=>1})
	    or die "Error connecting to database: $DBI::errstr";
	my $select_stmt = $dbh->prepare(<<SQL);
select messagetime, userid, username, message
  from chatter where chatterbox=?
 order by messagetime
SQL
    ;
	my $pmurl = $boxes{$box}{URL} . '?';
	$url .= "?site=$box";
	$url .= '&plain=1' unless $plain;

	$html =
	    start_html('-title' =>
		           "$boxes{$box}{NAME} Recent Chatterbox Messages",
		       '-dtd'   => "-//W3C//DTD HTML 4.0 Transitional//EN")
		. basefont({face  => "Arial",
			    size  => "2",
			    color => "black"})
		. h3("gmtime is ", &_timestamp)
		. p(a({href=>$url},
		      $plain?"Formatted":"Unformatted"))
		. start_table({cellspacing => 2, width => "100%",
			       cellpadding => 2, border => 1});
	$select_stmt->execute($box);
	while (my $msg = $select_stmt->fetchrow_hashref) {
	    my $user_ref = a( { href=>$pmurl.'node_id='.$msg->{userid} },
			      $msg->{username});
	    my $text = $msg->{message};
	    my $output;
	    my $me = 0;
	    if ($plain) {
		$output .= escapeHTML($text);
	    } else {
		if ($text =~ m|^/me\W|) {
		    $output = $user_ref;
		    $text = substr($text,3);
		    $me++;
		}
		$output .= &format_message($text,$pmurl);
	    }
	    $output = i($output) if $me;
	    $html .= start_Tr . start_td;
	    $html .= font({'-size' => '2'},
			  $user_ref, br, $msg->{messagetime}
			  );
	    $html .= end_td . start_td;
#	    $html .= textarea(-default=>$msg->{message}, -rows=>3, -columns=>80);
	    $html .= span($output);
	    $html .= end_td . end_Tr;
	}
	$select_stmt->finish;
	$dbh->disconnect;

	$html .= end_table;

	$html .= p("No recent messages.") if $select_stmt->rows == 0;
	
	$html .= hr
	    . a( {'href' => "http://validator.w3.org/check/referer"},
		 img( {'src'=>"valid-html40.png",
		       'alt'=>"Valid HTML 4.0!",
		       'border'=>"0",
		       'height'=>"31",
		       'width'=>"88"}
		      )
		 )
		. end_html;
    }
}

    print  header(-type => 'text/html',
		  -content_length => length($html),
                  -expires => '+5m'  ), # cache only for five minutes
           $html;

exit;
################################## SUBLAND ######<<<<<<<<<<<<<<<<<<<<<<<<|~
################################## SUBLAND       >>>>>>>>>>>>>>>>>>>>>>>>|~


=head2 C<&_timestamp>

returns current perlmonks compatible gmtime

=cut

sub _timestamp      # current gmtime
{
    @_ = (gmtime(time))[5,4,3,2,1,0];
                    # gimme a slice of that list
    $_[0]+=1900;    # hey hey, y 2 k
    $_[1]+=1;       # 0..11 ne 'true month'
    return sprintf("%04u-%02u-%02u %02u:%02u:%02u", @_);
}

=head2 C<&show_available_boxes>

Displays a list of chatterboxes for which this system keeps histories.

=cut

sub show_available_boxes {
    my $html =
	start_html('-title' => "Recent Chatterbox Messages",
		   '-dtd'   => "-//W3C//DTD HTML 4.0 Transitional//EN")
	. basefont({face  => "Arial",
		    size  => "2",
		    color => "black"})
	. h1('Available Chatterbox Histories')
	. p(q(Chatterbox messages from within the past hour are available
	      for the following sites))
	. ul( li( [ map { a({href=>url.'?site='.$_},
			    $boxes{$_}{NAME}) } sort keys %boxes ] ) )
	. end_html;
    return $html;
}

=head2 C<&addurls($siteurl,$p1,$p2>

Called from within a regex to convert bracketed text to urls.

C<$siteurl> should be the base URL for the site with a C<?> appended.

C<$p1> is the first part of the bracketed text (before the pipe).

C<$p2> is the second part of the bracketed text (after the pipe) or
undefined.

=cut

sub addurls {
    my ($siteurl,$p1,$p2) = @_;
    my $url;
    my $text;
# is a protocol specified?
    if ($p1 =~ m|^(\w+)://(.*)|) {
# match known 'protocols'
	if ($1 eq 'id') {
	    $url = $siteurl."node_id=$2";
	    $p2 = "node $2" unless $p2;
	} elsif ($1 eq 'pad') {
	    $url = $siteurl."node=Scratch Pad Viewer&user=$2";
	    $p2 = "$2's scratchpad" unless $p2;
	} elsif ($1 eq 'google') {
	    $url = "http://www.google.com/search?text=$2";
	    $p2 = $2 unless $p2;
	} elsif ($1 eq 'http') {
	    $url = $p1;
	} elsif ($1 eq 'cpan') {
	    $url = "http://search.cpan.org/search?mode=module&query=$2";
	    $p2 = $2 unless $p2;
	}
    } else {
# just text, it's a page on the site
	$url = $siteurl."node=$p1";
	$p2 = $p1 unless $p2;
    }
    if ($url) {
# generate the address tag
	$text = $p2 ? $p2 : $url;
	$text = a({href=>$url},$text);
    } else {
# can't figure out what they're trying to link to
	$text = "[$p1";
	$text .= "|$p2" if $p2;
	$text .= ']';
    }
    $text;
}

=head2 C<&format_message>

Scans the message text for HTML tokens and bracketed text and
generates new HTML.

=cut

sub format_message {
    my ($text,$siteurl) = @_;
    my $output = "";
    my $tp = HTML::TokeParser->new(\$text);
    my $code = 0;
  TOKEN:
    while (my $tok = $tp->get_token) {
	if ($tok->[0] eq 'T') {
	    if ($code) {
		$output .= escapeHTML($tok->[1]);
	    } else {
		my $t = $tok->[1];
		$t =~ s{\[([^|\]]+)(?:\|([^\]]+))?\]}
		{&addurls($siteurl,$1,$2)}ge;
		$output .= $t;
	    }
	    next TOKEN;
	}
	if ($tok->[0] eq 'S') {
	    if ($code) {
		$output .= escapeHTML($tok->[4]);
		next TOKEN;
	    }
	    if ($tok->[1] eq 'code') {
		$output .= $tok->[4];
		$code++;
		next TOKEN;
	    }
	    if ($allowed{$tok->[1]}) {
		$output .= $tok->[4];
	    } else {
		$output .= escapeHTML($tok->[4]);
	    }
	    next TOKEN;
	}
	if ($tok->[0] eq 'C') {
	    $output .= escapeHTML($tok->[1]);
	    next TOKEN;
	}
	if ($tok->[0] eq 'E') {
	    if ($code) {
		if ($tok->[1] eq 'code') {
		    $output .= $tok->[2];
		    $code = 0;
		} else {
		    $output .= escapeHTML($tok->[2]);
		}
		next TOKEN;
	    }
	    if ($allowed{$tok->[1]}) {
		$output .= $tok->[2];
	    } else {
		$output .= escapeHTML($tok->[2]);
	    }
	    next TOKEN;
	}
	$output .= escapeHTML($tok->[-1]);
    }
    $output;
}

=head2 C<&show_links>

Display links to related sites on the index page.

=cut

sub show_links {
    dl(map { ($a,$b) = split /\t/; dt(a({href=>$a},$a)).dd($b) } <DATA> );
}

# related site list
# site\tdescription
__DATA__
http://sourceforge.net/projects/jchatter/	Java Chatterbox project page on SourceForge
jchatter.diff	Patch to Java Chatterbox to allow selection of a chatterbox on the command line