[ create a new paste ] login | about

Link: http://codepad.org/KTAh4hRh    [ raw code | fork ]

Perl, pasted on Apr 19:
#!/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);


Create a new paste based on this one


Comments: