lib/Chat/Comchat.pm

## -*- Perl -*- -*- Coding: euc-jisx0213 -*-

=head1 NAME

Chat::Comchat

=head1 DESCRIPTION

SuikaChat - Comchat-compatible data file
=cut

use strict;
package Chat::Comchat;
use vars qw($VERSION);
$VERSION = '1.01';
use base qw(Chat::Suika);

sub open($$) {
  my $class = shift;
  my $file = shift;
  
  my @CHAT;
  if (CORE::open CHAT, $file) {@CHAT = <CHAT>; close CHAT}
  
  bless {file => $file, data => \@CHAT}, $class;
}

sub say($%) {
  my $self = shift;
  my %saying = @_;
  return $self unless $saying{text};
  #$saying{time} = Suika::CGI::timetext() unless $saying{time};
  $saying{time} = gmtime()." GMT" unless $saying{time};
  $saying{name} = 'foo' unless $saying{name};
  for ($saying{name}, $saying{text}) {
    tr/\x0d\x0a//d;
    s/&/&amp;/g; s/"/&quot;/g; s/</&lt;/g; s/>/&gt;/g;
  }
  my $newtext = $saying{time}.'<>'.$saying{name}.'<><>'.
                $saying{text}.'<><>'.$saying{ip}."\n";
  
  CORE::open(CHAT, '>> '. $self->{file});
    #or Suika::CGI::Error::die('write', file => $self->{file});
    print CHAT $newtext;
  close CHAT;
  $self;
}

sub get($%) {
  my $self = shift;
  my %param = @_;
  $param{start} = 0 unless $param{start};
  $param{end} = $#{$self->{data}} unless $param{end};
  $param{end} = $param{start} if $param{end} < $param{start};
  my @ret;
  
  for (my $i = $param{start}; $i <= $param{end}; $i++) {
    my ($time, $name, $mail, $text, $namecolor, $ip, $textcolor)
      = split /<>|\x0d|\x0a/, $self->{data}->[$i];
    push @ret, {time => $time, name => $name, text => $text, ip => $ip,
                mail => $mail, textcolor => $textcolor, namecolor => $namecolor};
  }
  
  wantarray? @ret: \@ret;
}

=head1 CHANGE

2001-11-10  wakaba <wakaba@suika.fam.cx>

        * use strict.

2001-05-11  wakaba <wakaba@suika.fam.cx>

        * New File.

=cut

1;
1	wakaba	1.1	## -- Perl -- -- Coding: euc-jisx0213 --
2
3			=head1 NAME
4
5			Chat::Comchat
6
7			=head1 DESCRIPTION
8
9			SuikaChat - Comchat-compatible data file
10			=cut
11
12			use strict;
13			package Chat::Comchat;
14			use vars qw($VERSION);
15			$VERSION = '1.01';
16			use base qw(Chat::Suika);
17
18			sub open($$) {
19			my $class = shift;
20			my $file = shift;
21
22			my @CHAT;
23			if (CORE::open CHAT, $file) {@CHAT = <CHAT>; close CHAT}
24
25			bless {file => $file, data => \@CHAT}, $class;
26			}
27
28			sub say($%) {
29			my $self = shift;
30			my %saying = @_;
31			return $self unless $saying{text};
32			#$saying{time} = Suika::CGI::timetext() unless $saying{time};
33			$saying{time} = gmtime()." GMT" unless $saying{time};
34			$saying{name} = 'foo' unless $saying{name};
35			for ($saying{name}, $saying{text}) {
36			tr/\x0d\x0a//d;
37			s/&/&/g; s/"/"/g; s/</</g; s/>/>/g;
38			}
39			my $newtext = $saying{time}.'<>'.$saying{name}.'<><>'.
40			$saying{text}.'<><>'.$saying{ip}."\n";
41
42			CORE::open(CHAT, '>> '. $self->{file});
43			#or Suika::CGI::Error::die('write', file => $self->{file});
44			print CHAT $newtext;
45			close CHAT;
46			$self;
47			}
48
49			sub get($%) {
50			my $self = shift;
51			my %param = @_;
52			$param{start} = 0 unless $param{start};
53			$param{end} = $#{$self->{data}} unless $param{end};
54			$param{end} = $param{start} if $param{end} < $param{start};
55			my @ret;
56
57			for (my $i = $param{start}; $i <= $param{end}; $i++) {
58			my ($time, $name, $mail, $text, $namecolor, $ip, $textcolor)
59			= split /<>\|\x0d\|\x0a/, $self->{data}->[$i];
60			push @ret, {time => $time, name => $name, text => $text, ip => $ip,
61			mail => $mail, textcolor => $textcolor, namecolor => $namecolor};
62			}
63
64			wantarray? @ret: \@ret;
65			}
66
67			=head1 CHANGE
68
69			2001-11-10 wakaba <wakaba@suika.fam.cx>
70
71			* use strict.
72
73			2001-05-11 wakaba <wakaba@suika.fam.cx>
74
75			* New File.
76
77			=cut
78
79			1;