#!/usr/bin/env perl # $Id: clkeitai.cgi,v 1.4 2004/06/04 13:08:30 yto Exp $ # clkeitai.cgi - chalow により HTML 化されたページをケータイで見る # アイテム一覧表示 - アンカーなどはなし。アイテム別表示へのジャンプ用。 # アイテム別表示 - アンカーあり use strict; use Jcode; use CGI; my $q = new CGI; # 携帯電話で表示できる最大バイト # たぶん、3k だと思うが、いろいろあるので余裕を見るのがよいかと。 my $page_size_max = 2500; print "Content-type: text/html; charset=Shift_JIS\n\n"; print qq(CHALOW Keitai ); if (defined $q->param('date')) { my $date = $q->param('date'); if ($date =~ /^\d{4}-\d\d-\d\d$/) { # アイテムじゃなくてエントリを指定してきたときに対処 print "Candidates: \n"; for (my $i = 1; $i < 10; $i++) { print qq($date-$i, ); } print "...\n"; exit; } output_an_item($date); } else { my $from = $q->param('from') || 1; output_simple_list($from); } ### アイテム別表示 sub output_an_item { my ($ymdi) = @_; my ($ymd, $ym) = ($ymdi =~ /^((\d{4}-\d\d)-\d\d)/); my $fn; if (-e "$ymd.html") { $fn = "$ymd.html"; } elsif (-e "$ym.html") { $fn = "$ym.html"; } else { print "No Entry $ymdi\n"; } open(F, "< $fn") or die "Can't open $fn : $!\n"; binmode(F); my $all = join('', ); close(F); my $outstr = "no match"; while ($all =~ m|start:$ymdi -->(.*?)||gsm; $new =~ s|
.*?
||gsm; # 記述者名除去 $new =~ s|||gsm; $new =~ s|||gsm; $new =~ s|||gsm; $new =~ s|||gsm; $new =~ s|(.+?)|$1|g; # ヘッダのを除去 $new =~ s|\[(.+?)\]|[$1]|g; # カテゴリのを除去 # img の処理 $new =~ s|()()()|$1<>$3 $2 |gsm; $new =~ s|| qq([$3($2)])|exg; # inside ref $new =~ s|| qq()|gxe; $new =~ s!^(<.+?>|)\t!$1!gsm; # 行頭のタブは絶体除去 $outstr = $new; last; } if (length($outstr) > $page_size_max) { $outstr = substr($outstr, 0, $page_size_max); $outstr =~ s|<[^>]*$||; $outstr =~ s|([\x00-\x7f]([\x80-\xff]{2})*)[\x80-\xff]$|$1|; $outstr .= "\n\n[長いので以降省略しました]\n"; } $outstr = jcode($outstr)->sjis; print "$ymdi

$outstr

\n"; } ### アイテム一覧表示 # anchor とかなし。文字列だけ。アイテム別表示へのリンクあり。 sub output_simple_list { my ($from) = @_; my $outstr = ""; my $len = 0; my $last = 0; my $fn = "cl.itemlist"; open(F, "< $fn") or die "Can't open $fn : $!\n"; binmode(F); while () { # print "$from $.\n"; if ($from <= $.) { my ($d, $c) = (/^(.+?)\t(.+)$/); $d =~ s|^.*?\[(\d{4}-\d\d-\d\d-\d+)\].*?$| qq(
$1)|ex; #$d =~ s/<.+?>//g; $c =~ s/<.+?>//g; my $URLCHARS = "[-_.!~*'a-zA-Z0-9;/?:@&=+,%\#\$]"; my $URLDELIM = "\\\\\\n[\\t ]+"; $c =~ s{(s?https?|ftp)://($URLCHARS+)}{$1://...}gm; my $new = "$d
$c
\n"; if (length($new) > $page_size_max) { # a item > max $new =~ s/
.*$/
(大きすぎなので非表示)
\n/; } if ($len + length($new) > $page_size_max) { $last = $.; last; } $len += length($new); $outstr .= $new; } } close(F); $outstr = jcode($outstr)->sjis; print << "HTML" $outstr << HTML ; }