package Dat;
use base Bbs;
use strict;
sub make
{
  my $t = $_[0]->from('time');
  my $dat = $_[0]->path('dat') . $t.'.dat';
  return if -e $dat;
  local $, = $_[0]->conf('delimiter');
  local $\ = "\n";
  open( FH, ">$dat" ) || return;
  flock FH, 2;
  print FH $_[0]->from('name'), $_[0]->from('mail'), $_[0]->from('date'), ' '.$_[0]->from('message'), $_[0]->from('subject');
  truncate FH, tell FH;
  close FH;
  $_[0]->counter('dat_line'=>1);
  $_[0];
}
sub read
{
  my $dat = $_[1] || $_[0]->path('dat') . $_[0]->from('key').'.dat';
  my @l;
  open( FH, "<$dat" ) || return;
  flock FH, 2;
  chomp, $l[$.-1] = $_ while <FH>;
  close FH;
  $_[0]->list( 'dat' => \@l );
  \@l;
}
sub write
{
  my $key = $_[0]->from('key');
  my $bbs = $_[0]->from('bbs');
  my $dat_file = $_[1] || $_[0]->path('dat') . $key.'.dat';
  my $tmp_file = $_[2] || $_[0]->path('html') . $key.'.html';
  my $limit = $_[0]->conf('limit_dat_line');
  my $contents = $_[0]->setting('CONTENTS_NUMBER');
  my $delimiter = $_[0]->conf('delimiter');
  my $count = 0;
  local $, = $delimiter;
  local $\ = "\n";

  open( FH, "+<$dat_file" ) || return;
  flock FH, 2;
  binmode FH;

  $count += tr/\n// while CORE::read FH, $_, 5120;

  $_[0]->flag('error'=>2, 'limit_dat_line'=>1), close(FH), return if $count > $limit;

  seek FH, 0, 2;

  print FH $_[0]->from('name'), $_[0]->from('mail'), $_[0]->from('date'), ' '.$_[0]->from('message'), '';

  $count++;
  $_[0]->counter('dat_line'=>$count);

  if ( $count >= $limit ) {
    $count++;
    $_[0]->counter('dat_line'=>$count);
    print FH ($_[0]->conf('limit_thread_name') || $count), '', $_[0]->conf('limit_thread_datetime'), ' '.$_[0]->conf('limit_thread_message'), '';
  }

  seek FH, 0, 0;

  $\ = '';
  $, = '';

  my @res; #１行目と最後からCONTENTS_NUMBER行が入る
  my @lines;
  my $bufsize = 1024;
  my $size = (-s FH) / $bufsize;
  my $pos; $pos += $size <=> ($pos = int($size));
  my $tmp; my $buf;

  #１行目を読み出す
  my $first = readline *FH;
  #seek FH, 0, 2;
  #end of １行目を読み出す

  #最後からCONTENTS_NUMBER行を読み出す 参考:Perlメモ
  while ($pos--) {
    seek FH, $bufsize * $pos, 0;  
    CORE::read FH, $buf, $bufsize;
    $buf .= $tmp;
    ($tmp, @lines) = $buf =~ /[^\x0D\x0A]*\x0D?\x0A?/g;
    pop @lines;
    unshift @res, @lines;
    last if @res >= $contents;
  }
  unshift @res, $tmp;
  @res = @res[-$contents .. -1] if @res > $contents;
  #end of 最後からCONTENTS_NUMBER行を読み出す 参考:Perlメモ

  unshift(@res, $first) if $count > $contents;

  $_[0]->Dat::_write_temp($tmp_file, \@res, $count);

  seek FH, 0, 2;
  truncate FH, tell FH;
  close FH;
  #flock解除

  #limit_dat_line以上の場合はスレストのパーミッション(パーミッションを落とす)にして書き込めなくする
  chmod($_[0]->permission('stopper'), $dat_file) if ($count-1) >= $limit;

  $_[0];
}
sub _write_temp
{
  my $s = shift;
  my $tmp_file = $_[0];
  my $res = $_[1];
  my $count = $_[2];
  my $bbs = $s->from('bbs');
  my $key = $s->from('key');
  my $script = $s->path('script').'read.cgi';
  my $line_number = $s->conf('limit_line_number')-1;
  my $delimiter = $s->conf('delimiter');
  my $br = $s->conf('line_break');
  my @msg;
  my @tmp;
  my @st = $count > $s->setting('CONTENTS_NUMBER') ? ((($count-($s->setting('CONTENTS_NUMBER')))+1)..$count) : (2..$count) ;
  my @res_number = ( 1, @st );
  my $i = 0;
  local $\ = "\n";

  return unless open TMP, ">$tmp_file";

  foreach( @{$res} ) {

    chomp;
    @tmp = split $delimiter;
    @tmp = ('[ここ壊れてます]', '', '[ここ壊れてます]', '[ここ壊れてます]') if $tmp[3] eq '' || ($tmp[4] eq '' && $i == 0);

    if($i==0) {
      print TMP qq(<div style="text-align:left;"><span class="thread_number">【<THREAD_NUMBER>:$count】</span><span class="thread_name">$tmp[4]</span></div>\n<dl>\n);
    }

    $s->replace_urianchor(\$tmp[3]);

    @msg = split $br, $tmp[3];
    if( $#msg > $line_number ) {
      my $href = "$script/$bbs/$key/$res_number[$i]".'n';
      $tmp[3] = join $br, (@msg[0..$line_number],qq(<span style="color:forestgreen;">（省\略\されました・・<a href="$href" target="_blank">すべて読む？</a>）</span>));
    }

    if (length $tmp[1] == 0) {
      print TMP qq(<dt>$res_number[$i] 名前：<strong style="color:forestgreen;">$tmp[0]</strong> 投稿日：$tmp[2]</dt><dd style="margin-bottom:1em;">$tmp[3]</dd>);
    } else {
      print TMP qq(<dt>$res_number[$i] 名前：<strong><a href="mailto:$tmp[1]">$tmp[0]</a></strong> 投稿日：$tmp[2]</dt><dd style="margin-bottom:1em;">$tmp[3]</dd>);
    }
    $i++;

  }
  print TMP qq(\n</dl>\n);
  truncate TMP, tell TMP;
  close TMP;
  $s;
}

=old_write
sub write
{
  my $key = $_[0]->from('key');
  my $bbs = $_[0]->from('bbs');
  my $dat = $_[1] || $_[0]->path('dat') . $key.'.dat';
  my $tmp = $_[2] || $_[0]->path('html') . $key.'.html';
  my $limit = $_[0]->conf('limit_dat_line');
  my $contents = $_[0]->setting('CONTENTS_NUMBER');
  my $delimiter = $_[0]->conf('delimiter');
  my $count = 0;
  local $, = $delimiter;
  local $\ = "\n";

  open( FH, "+<$dat" ) || return;
  flock FH, 2;

  $count += tr/\n// while sysread FH, $_, 5120;

  $_[0]->flag('error'=>2, 'limit_dat_line'=>1), close(FH), return if $count > $limit;

  seek FH, 0, 2;

  if ( $count >= $limit ) {
    print FH ($_[0]->conf('limit_thread_name') || $count),'',$_[0]->conf('limit_thread_datetime'),' '.$_[0]->conf('limit_thread_message');
  }
  else {
    print FH $_[0]->from('name'), $_[0]->from('mail'), $_[0]->from('date'), ' '.$_[0]->from('message'), '';
  }
  $count++;
  $_[0]->counter('dat_line'=>$count);

  seek FH, 0, 0;

  open TMP, ">$tmp";

  my @s;
  my @msg;
  my $br = $_[0]->conf('line_break');
  my $line_number = $_[0]->conf('limit_line_number')-1;
  my $script = $_[0]->path('script').'read.cgi';
  my $st = 0;
  my $i = 1;
  my $line;

  local $\ = '';

  while($line=<FH>){
    chomp;
    if ( $i == 1 || $i > ( $count - $contents ) ){
      @s = split $delimiter, $line;
      @s = qw([ここ壊れてます] [ここ壊れてます] [ここ壊れてます] [ここ壊れてます]) if $s[3] eq '' || ($s[4] eq '' && $i == 1);
      if($i==1){
        print TMP qq(<div style="text-align:left;"><span class="thread_number">【<THREAD_NUMBER>:$count】</span><span class="thread_name">$s[4]</span></div>\n<dl>\n);
      } else {
        $_[0]->replace_urianchor(\$s[3]);
        @msg = split $br, $s[3];
        if( $#msg > $line_number ){
          $s[3] = '';
          my $tmp = "$script/$bbs/$key/$i".'n';
          $s[3] = join $br, (@msg[0..$line_number],qq(<span style="color:forestgreen;">（省\略\されました・・<a href="$tmp" target="_blank">すべて読む？</a>）</span>));
        }
      }
      if (length $s[1] == 0) {
        print TMP qq(<dt>$i 名前：<strong style="color:forestgreen;">$s[0]</strong> 投稿日：$s[2]</dt><dd style="margin-bottom:1em;">$s[3]</dd>);
      } else {
        print TMP qq(<dt>$i 名前：<strong><a href="mailto:$s[1]">$s[0]</a></strong> 投稿日：$s[2]</dt><dd style="margin-bottom:1em;">$s[3]</dd>);
      }
    }
    $i++;
  }
  print TMP qq(\n</dl>\n);

  truncate TMP, tell TMP;
  close TMP;

  truncate FH, tell FH;
  close FH;

  chmod($_[0]->permission('stopper'), $dat) if ($count-1) >= $limit;

  $_[0];
}
=cut

1;
__END__