#!/usr/bin/perl -w
use strict;

use Data::Dumper;
use XML::Simple;
$XML::Simple::PREFERRED_PARSER="XML::Parser";
use XML::RSS;
use CGI;

my $backend_file = 'fichier.xml';
my $title = q/Tu t'exprimes ou tu déprimes !/;
my $max_url_len = 60;

my $q = new CGI;
my $text = $q->param('text');

# XXX normaliser les espaces
if (($text) && $text ne '') {
    Tribune->new('fichier.xml')->add_line($text);
} 

my $mode = $q->param('mode');

my $tribune;

if ($mode && $mode eq 'rss') {
    $tribune = TribuneRss->new($backend_file);

} else {
    my @themes = qw(Tribune TribuneBoites IrcTribune);
    $tribune = $themes[int(rand(3))]->new($backend_file);
}

$tribune->display();

package Tribune;
use Fcntl qw(:DEFAULT :flock);

sub new {
    my $self = {};
    bless $self, shift;
    $self->{filename} = shift;

    open my $fh, "<", $self->{filename};
    flock $fh, LOCK_EX;
    my $s; { local $/; $s = <$fh>; }
    $self->{'data'} = XML::Simple->new->XMLin($s, SuppressEmpty => '');
    flock $fh, LOCK_UN;
    close $fh;
    return $self;
}

sub _escape {
    shift;
    $text = $q->escapeHTML(shift);

    # Collecte des urls
    my $i = 1;
    my @urls = grep { $i++ % 2 } $text =~ m#((http|ftp|news|nntp|file)://\S+)#gi;
    my %saw; 
    @urls = grep (!$saw{$_}++, @urls); # Elimination des doublons

    foreach my $url (@urls) {
        my $displayed_url = $url;
        
        if(length $url > $max_url_len) {
            $displayed_url = substr($displayed_url, 0, $max_url_len) . '(...)';
        }
        
        $text =~ s#\Q$url\E#<a href="$url">$displayed_url</a>#gi;
    }
    $text =~ s#\n# #gi;
    return $text;
}

sub add_line {
    my $self = shift;
    my $text = shift;
    #my $text = shift;
    while ($#{ $self->{'data'}->{'line'} } > 200) {
        pop @{ $self->{'data'}->{'line'} };
    }
    unshift @{ $self->{'data'}->{'line'} }, { 
        date => time,
        content => $text
    };
    open my $fh, ">", $self->{filename};
    flock $fh, LOCK_EX;
    print $fh XML::Simple->new->XMLout(
        $self->{'data'},
        NoAttr => 1, 
        RootName => 'plop',
        XMLDecl => '<?xml version="1.0" encoding="iso-8859-1" ?>'
    );
    flock $fh, LOCK_UN;
    close $fh;
    print $q->redirect($ENV{'SCRIPT_NAME'});
    exit(0);
}

sub display {
    my $self = shift;
    print "Content-type:text/html\n\n";
    my @rsslink = ($q->Link({
                -rel   => 'alternate', 
                -type  => 'application/rss+xml',
                -title => 'RSS',       
                -href  => $q->self_url . '?mode=rss'
            }));
    print $q->start_html(
        -style => { -src => $self->get_css() }, 
        -title => $title,
        -lang  => 'fr-FR',
        -head  => \@rsslink,
	-encoding => 'iso-8859-1'
    );
    $self->print_html();
}

sub get_css {
    return '/style.css';
}

sub print_html {
    my $self = shift;
    print <<HTML;
    <h1>$title</h1>
        <div class="form">
        <form action="$ENV{'SCRIPT_NAME'}" method="get">
          <input type="text" size="50" name="text" class="text" />
          <input type="submit" value="Pan !" />
        </form>
        </div>
HTML
    $self->print_body();
    print $q->end_html;
}

sub print_body {
    my $self = shift;
    print '<table>';
    $self->print_each_lines();
    print '</table>';
}

sub print_each_lines {
    my $self = shift;
    foreach ( @{ $self->{'data'}->{'line'} } ) {
        if (exists $_->{content}) {
            $self->print_one_line($self->get_date($_->{date}), $_->{content});
        }
    }
}

sub get_date {
    my $self = shift;
    my $time = shift;
    my $date = ' ';
    if (defined $time and $time ne '') {
        my @localtime = localtime($_->{date});
        my $y = $localtime[5] + 1900;
        my $m = sprintf("%02d", $localtime[4] + 1);
        my $d = sprintf("%02d", $localtime[3]);
        my $h = sprintf("%02d", $localtime[2]);
        my $mn = sprintf("%02d", $localtime[1]);
        $date = "$y-$m-$d&nbsp;$h:$mn";
    }
}

sub print_one_line {
    my $self = shift;
    my $date = shift;
    my $content = shift;
    print '<tr><td>', $date, 
    '</td><td>', $self->_escape($content), "</td></tr>\n";
}

package TribuneRss;
use base qw(Tribune);

sub display {
    my $self = shift;
    my $my_url = $q->self_url;
    $my_url =~ s/\?mode=rss//;
    my $rss = new XML::RSS (version => '2.0', encoding => 'iso-8859-1');
    $rss->channel( title  => $title, 'link' => $my_url);

    foreach ( @{ $self->{'data'}->{'line'} } ) {

        my $item_title = $_->{content};
        if (length $item_title > 60) {
            $item_title = substr($item_title, 0, 60) . '(...)';
        }

        my $link;
        if ($_->{content} =~ m#((http|ftp|news|nntp|file)://\S+)#) {
            $link = $1;
        } else {
            $link = $my_url;
        }

        $rss->add_item(
            title       => $item_title,
            "link"      => $link,
            description => $_->{content}
        );
    }

    print "Content-disposition: filename=patate.rss\nContent-type: text/xml\n\n";
    print $rss->as_string;
}

package TribuneBoites;
use base qw(Tribune);

sub print_body {
    my $self = shift;
    print '<dl>';
    $self->print_each_lines();
    print '</dl>';
}

sub print_one_line {
    my $self = shift;
    print '<dt>', shift, 
    '</dt><dd>', $self->_escape(shift), "</dd>\n";
}

sub get_css {
    return '/boites.css';
}

package IrcTribune;
use base qw(Tribune);

sub print_body {
    my $self = shift;
    print '<dl>';
    $self->print_each_lines();
    print '</dl>';
}

sub print_one_line {
    my $self = shift;
    print '<p>[', shift, ']&nbsp;', $self->_escape(shift), "</p>\n";
}

sub get_css {
    return '/irc.css';
}

sub print_each_lines {
    my $self = shift;
    foreach ( reverse @{ $self->{'data'}->{'line'} } ) {
        if (exists $_->{content}) {
            $self->print_one_line($self->get_date($_->{date}), $_->{content});
        }
    }
}

sub print_html {
    my $self = shift;
    print q{<a href="#bottom">Aller en bas</a>};
    $self->print_body();
    print <<HTML;
        <div class="form">
        <form action="$ENV{'SCRIPT_NAME'}" method="get">
          <input type="text" size="50" name="text" class="text" />
        </form>
        </div>
    <h1>$title</h1>
    <a name="bottom"></a>
HTML
    print $q->end_html;
}

__END__