#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
use strict;
use warnings;
use lib qw(./lib);
use CGI;
use DBIx::Simple;
use Digest::SHA1 qw(sha1_hex);
my $q = CGI->new;
print $q->header(-charset=>'utf-8',-expires=>'now'),
$q->start_html(-title=>'message',-lang=>'ja'),
$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('leave a secret mess'),
$q->end_form,
$q->hr;
# DBを開く
my $db = DBIx::Simple->connect('dbi:SQLite:dbname=secret_message.db')
or die DBIx::Simple->error;
# テーブルが無ければ作成する
$db->query(qq{CREATE TABLE IF NOT EXISTS message (key, value)});
# キーが入力されていた場合
if ( $q->param('key') ) {
# キーと合致するメッセージを取得
my @mes = $db->select(
'message',
'value',
{ key => [$q->param('key')] }
)->hashes;
# メッセージを表示
for my $m (@mes) {
print $m->{'value'}, qq{\n<hr>\n};
}
# キーと合致するメッセージを削除
$db->delete('message', { key => $q->param('key') });
print qq{This message is automatically deleted from the Web server.<br />};
}
# メッセージが入力されていた場合
if ( $q->param('value') ) {
# リモートアドレスとtimeからキーを生成
my $key = sha1_hex($q->remote_addr . time);
# キーとメッセージを対にしてDBに挿入
$db->insert(
'message',
{
key => $key,
value => $q->param('value')
}
);
# キー付きアドレスを表示
print qq{send this URL to friend<br />},
$q->url(),
qq{?key=$key<hr>};
}
print $q->end_html;
$db->disconnect;