--- title: perlでcgiを作る author: kazu634 date: 2009-06-06 url: /2009/06/06/_1268/ wordtwit_post_info: - 'O:8:"stdClass":13:{s:6:"manual";b:0;s:11:"tweet_times";i:1;s:5:"delay";i:0;s:7:"enabled";i:1;s:10:"separation";s:2:"60";s:7:"version";s:3:"3.7";s:14:"tweet_template";b:0;s:6:"status";i:2;s:6:"result";a:0:{}s:13:"tweet_counter";i:2;s:13:"tweet_log_ids";a:1:{i:0;i:4647;}s:9:"hash_tags";a:0:{}s:8:"accounts";a:1:{i:0;s:7:"kazu634";}}' categories: - Perl ---

これだけは知っておきたい Webアプリケーションの常識』の勉強中です:

クッキーの利用

# === Libraries ===
use strict;
use warnings;
use CGI::Cookie;
# === Main part ===
# Cookieを取得する
my %cookies = fetch CGI::Cookie;
# countクッキーの値を得て、1増やす
my $count = ;
if ( defined( $cookies{count} ) ) {
$count = $cookies{count}->value;
}
$count++;
# 更新後のcountクッキーを生成する
my $cookies = new CGI::Cookie(
-name   => 'count',
-value  => $count,
-expire => '+3M',
-path   => '/'
);
# レスポンスの送信
print("Set-cookie: $cookies\n");
print("Content-type: text/html; charset=utf-8\n\n");
print("訪問回数は$count回です\n");

キャッシュを利用する

# === Libraries ===
use strict;
use warnings;
use Cache::File;
# === Main part ===
my $cache_msg;
# キャッシュの初期化
my $cache = Cache::File->new(cache_root => '/tmp/cache');
# キャッシュからHTMLを得る
my $time_html = $cache->get('time.html');
# キャッシュが無効なら、HTMLを生成してキャッシュに保存する
if (!$time_html) {
my @t = localtime;
$time_html = sprintf('現在時刻は %2d 時 %2d 分 %2d 秒です。', $t[2], $t[1], $t[]);
$cache->set('time_html', $time_html, '60 sec');
$cache_msg = 'キャッシュを更新しました。';
}
# ページの出力
print <<HERE;
Content-type: text/html; charset=utf-8
<title>キャッシュのセット</title>
<p>
$time_html<br />
$cache_msg
</p>
HERE

簡単なAjaxサンプル

HTMLのページ:

<!DOCTYPE htmlUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR.xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
    <title>The Example of Ajax</title>
    <meta name="Content-Type" content="text/html; charset=UTF-8" />
    <meta name="Content-Script-Type" content="text/javascript" />
  </head>
<body>
<script type="text/javascript" src="prototype.js"></script>
<script type="text/javascript">
      //<![CDATA[
function lwws() {
// 結果の表示先に「しばらくお待ちください」と表示する
    document.getElementById("result").innerHTML = "<p>しばらくお待ちください...</p>";
    new Ajax.Updater(
        "result", "./cgi-bin/weather.pl",
        {
            parameters : Form.serialize("ajax"),
            method : "get"
        }
    );
}
      //]]>
    </script>
<h1>The Example of Ajax</h1>
<form method="get" id="ajax" action="" name="ajax">
<p>
都市:
<select name="city" size="1">
<option value="4">札幌</option>
<option value="25">仙台</option>
<option value="63">東京</option>
<option value="70">横浜</option>
<option value="38">名古屋</option>
<option value="81">大阪</option>
<option value="90">広島</option>
<option value="110">福岡</option>
</select>
<input type="button" value="送信" onclick="lwws()" />
</p>
</form>
<p>通信結果</p>
<div id="result"></div>
<address>
<a href="mailto:simoom634@kazu634.local">simoom634</a>
</address>
</body>
</html>

Perl側:

# === Libraries ===
use strict;
use warnings;
use LWP::Simple;
use XML::Simple;
use CGI;
use utf8;
# === Main part ===
my $q = new CGI;
my $city = $q->param('city') || '';
my $url = "http://weather.livedoor.com/forecast/webservice/rest/v1?city=${city}&day=tomorrow";
my $xml = get($url);
my $data = XMLin($xml);
print("Content-type: text/html; charset=utf-8\n\n");
print("\xef\xbb\xbf");
binmode(STDOUT, ":utf8");
print("<p>" . $data->{location}->{city} . "の明日の天気<br />\n");
print($data->{telop} . "<br />\n");
print("<img src=\"" . $data->{image}->{url} . "\" width=\"" . $data->{image}->{width} . "\" height=\"" . $data->{image}->{height} . "\" alt=\"" . $data->{image}->{title} . "\" /><br />\n");
print($data->{description} . "<br />\n");
if (ref $data->{temperature}->{min}->{celsius} eq 'HASH') {
print("最低気温: データがありません<br />\n");
} else {
print("最低気温: " . $data->{temperature}->{min}->{celsius} . "度<br />\n");
}
if (ref $data->{temperature}->{max}->{celsius} eq 'HASH') {
print("最低気温: データがありません<br />\n");
} else {
print("最低気温: " . $data->{temperature}->{max}->{celsius} . "度<br />\n");
}
print("</p>\n");

「perl」に関連する最近のエントリ

これだけは知っておきたい Webアプリケーションの常識

これだけは知っておきたい Webアプリケーションの常識