package CGI::Chat::Simple;

use strict;

use URI::Escape;
use HTML::Entities;
use Tie::File;
use POSIX qw(strftime);

use base qw[ CGI::Application ];

use vars qw( $VERSION );

$VERSION = '0.01';

=head1 NAME

CGI::Chat::Simple - A very simple and insecure webchat

=head1 DESCRIPTION

This is an instant webchat.

=head1 SYNOPSIS

=for example begin

  use strict;
  use CGI::Chat::Simple;
  my $chat = CGI::Chat::Simple->new( TMPL_PATH => "templates", )->run;

=for example end

=head1 METHODS

=over 4

=item B<new>

=cut

sub new {
  my ($class) = shift;
  my $self = $class->SUPER::new(@_);
  $self;
};

=item B<setup>

The C<setup> method is called by the CGI::Application framework
when the application should initialize itself and load all necessary
parameters. The wiki decides here what to do and loads all needed values
from the configuration or database respectively. These parameters are
passed to the wiki via the C<PARAMS> parameter of CGI::Application, as
C<setup> is not called directly. So the general use is like this :

=for example begin

  my $wiki = CGI::Wiki::Simple
             ->new( PARAMS => {
             										# to be done
                              })->run;

=for example end

C<setup> takes a list of pairs as parameters, one mandatory and some optional :

=cut

sub setup {
  my ($self) = @_;
  $self->run_modes(
    login    => 'render_login',
    frame    => 'render_frame',
    messages => 'render_messages',
    users    => 'render_users',
    input		 => 'render_input',
  );
  $self->mode_param( \&decode_runmode );
  $self->start_mode("login");

  my $q = $self->query;

  my %default_config = (
  							 script_name     => $q->script_name,
  );

  my %args;
  $args{$_} = defined $self->param($_) ? $self->param($_) : $default_config{$_}
    for (keys %default_config);

  $self->param( $_ => $args{$_})
    for qw( script_name action );

  my (@messages);
  tie @messages,'Tie::File','messages.log'
    or die "Couldn't tie message database";
  $self->param( messages => \@messages );

  # Maybe later add the connection to the database here...
};

=item B<decode_runmode>

C<decode_runmode> decides upon the url what to do. It also
initializes the following CGI::Application params :

  user
  action
  message
  messagecount
  id

=cut

sub decode_runmode {
  my ($self) = @_;
  my $q = $self->query;
  my $action = $q->param("action");

  # Magic runmode decoding :
  my %rms = $self->run_modes;
  my $runmodes = join "|", map { quotemeta } keys %rms;
  if ($q->path_info =~ m!^/($runmodes)\b!) {
    $action = $1;
    $q->param("action","");
  };
  $action ||= 'login';

  $self->param( $_ => $self->query->param($_))
    for qw( user action message id messagecount );

  my (@seen);
  tie @seen,'Tie::File','seen.log'
    or die "Couldn't tie seen database";
  my %seen_uniq = map { split "\0" } @seen;
  if ($self->param('user')) {
    $seen_uniq{$self->param('user')} = time();
  };
  @seen = map { $_ . "\0" . $seen_uniq{$_} } grep { time - $seen_uniq{$_} < 120 } sort keys %seen_uniq;
  $self->param( seen => [ sort keys %seen_uniq ]);

  $action;
};

=item B<teardown>

The C<teardown> sub is called by CGI::Application when the
program ends. Currently, it does nothing in CGI::Wiki::Simple.

=cut

sub teardown {
  my ($self) = @_;
  # Maybe later add the database disconnect here ...
};

sub load_tmpl {
  my ($self,$name) = @_;
  my $template = $self->SUPER::load_tmpl( $name, die_on_bad_params => 0 );
  $template->param($_,$self->param($_)) for qw(script_name user id );
  $template;
};

sub render {
  my ($self,$templatename,$actions,@params) = @_;
  my $template = $self->load_tmpl($templatename);
  $self->load_actions($template, map { $_ => 1 } @$actions );
  $template->param( $_ => $self->param( $_ )) for @params;
  $template->output;
};

sub render_login {
  my $self = shift;
  my $template = $self->load_tmpl('login.tmpl');
  $template->output;
};

sub render_frame {
  my $self = shift;
  my $template = $self->load_tmpl('frame.tmpl');
  $template->output;
};

sub render_input {
  my $self = shift;

  if ($self->param('message')) {
    my $line = join "\0",$self->param('user'),$self->param('message'),time();
    push @{$self->param('messages')}, $line;
  };

  my $template = $self->load_tmpl('input.tmpl');
  $template->param(id => time() . rand );
  $template->output;
};

sub render_messages {
  my $self = shift;
  my $template = $self->load_tmpl('messages.tmpl');
  my $messagecount = $self->param('messagecount') || 15;
  my @messages = map { my @arr = split /\0/;
                       { name => $arr[0],
                         message => $arr[1],
                         timestamp => strftime('%Y%m%d-%H:%M:%S',localtime($arr[2]))
                       }
                     } @{$self->param('messages')};
  shift @messages
    while @messages > $messagecount;
  $template->param( messages => \@messages );
  $template->output;
};

sub render_users {
  my $self = shift;
  my $template = $self->load_tmpl('users.tmpl');
  $template->param( users => [ map { { name => $_ } } @{$self->param('seen')} ] );
  $template->output;
};

1;

=head1 AUTHOR

Max Maischein (corion@cpan.org)

=head1 COPYRIGHT

     Copyright (C) 2003 Max Maischein.  All Rights Reserved.

This code is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

perl