[ create a new paste ] login | about

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

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


Create a new paste based on this one


Comments: