#!/usr/local/bin/perl
use strict;
use warnings;
use utf8;
use lib qw(./lib);
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Encode;
use DBIx::Simple;
use Digest::SHA1 qw(sha1_hex);
# メッセージを残す秒数
my $REMAIN = 24 * 60 * 60; # とりあえず一日
my $time = time;
my $q = CGI->new;
# パラメータをデコードし、utf8フラグを付加する
my %param = map { $_ => decode_utf8($q->param($_)) } $q->param;
# DBを開く
my $db = DBIx::Simple->connect('dbi:SQLite:dbname=secret_message.db')
or die DBIx::Simple->error;
# テーブルが無ければ作成する
$db->query( q{CREATE TABLE IF NOT EXISTS message (created_at, key, value)} );
# 指定秒数経過したメッセージを消す
$db->delete('message', { 'created_at' => { '<=', $time - $REMAIN } });
my $output = join '',
$q->header(-charset => 'utf-8'),
$q->start_html(-title=>'message',-lang=>'ja-JP');
# キーが入力されていた場合
if ( $param{'key'} ) {
# キーと合致するメッセージを取得
my @mes = $db->select(
'message',
'value',
{ key => [$param{'key'}] }
)->hashes;
# メッセージを表示
unless (scalar(@mes)) {
$output .= qq{メッセージは見つかりませんでした。<br />};
} else {
for my $m (@mes) {
# CGI.pm はutf8フラグを落とした文字列を返すため、出口に合わせて一旦フラグを立てておく
my $string = decode_utf8($q->escapeHTML($m->{'value'}));
$string =~ s#\n#<br />#g;
$output .= $string . qq{\n<hr>\n};
}
$output .= qq{このメッセージは自動的に消去されます。<br />};
$output .= $q->hr;
}
# キーと合致するメッセージを削除
$db->delete('message', { key => $param{'key'} });
}
# メッセージが入力されていた場合
if ( $param{'value'} ) {
# リモートアドレスとメッセージからキーを生成
my $key = sha1_hex(encode_utf8($q->remote_addr . $time));
# キーとメッセージを対にしてDBに挿入
$db->insert(
'message',
{
'created_at' => $time,
'key' => $key,
'value' => $param{'value'}
}
);
# キー付きアドレスを表示
$output .= join '',
qq{メッセージを保存しました。<br />このURLを見せたい相手に送ってください。<br />},
$q->textarea(-name=>'URL',-default=>$q->url().'?key='.$key,-cols=>20,-rows=>2),
$q->br,
$q->url(),
qq{?key=$key<hr>};
} else {
$output .= join '',
$q->start_form(-action=>$q->script_name,-enctype=>'application/x-www-form-urlencoded'),
$q->textarea(-name=>'value',-rows=>3,-cols=>20),
$q->br,
$q->submit('メッセージを残す'),
$q->end_form;
}
$db->disconnect;
$output .= $q->end_html;
print encode_utf8($output);