Category: Perl

Allow declaration of constants at compile time.

use constant PI => 4 * atan2(1, 1);
use constant DEBUG => 0;

print "Pi equals ", PI, "...\n" if DEBUG;

use constant{
	SEC => 0,
	MIN => 1,
	HOUR => 2,
	MDAY => 3,
	MON => 4,
	YEAR => 5,
	WDAY => 6,
	YDAY => 7,
	ISDST => 8,
};

use constant WEEKDAYS => qw(
	Sunday Monday Tuesday Wednesday Thursday Friday Saturday
);

print "Today is ", (WEEKDAYS)[ (localtime)[WDAY]], ".\";

Sledge::SessionManager type
-> module to decide the method of passing session ID

Sledge::SessionManager::Cookie
-> Pass session ID using cookie.

Sledge::SessionManager::StickyQuery
->Receive session ID from QUERY_STRING. Session ID is passed embedded in HTML.

Sledge::SessionManager::Rewrite
->We do something similar to Sledge::SessionManager::StickyQuery using mod_rewrite.

– Special session management module
Sledge::SessionManager::CookieStore
Embed session data in a cookie. Install it separately.

Modules are made as classes. “use” is a class definition declaration.
“CGI” is a very easy name, but it is actually a class(function set) that processes basic CGI parameters in the basics when creating CGIs.
Therefore, “use CGI” defines a class of CGI module.

“use CGI” is an object-oriented style, and “use CGI qw(:standard);” is a function style declaration.

#!/usr/bin/perl --
use strict;
use warnings;
use CGI qw(:standard);

#! /usr/local/bin/perl

use strict;
use warnings;

# 環境依存
use lib "$ENV{DOCUMENT_ROOT}/lib/perl5";
use lib "$ENV{DOCUMENT_ROOT}/lib";
use lib "./lib";

use CGI qw|:standard|;
use CGI::Session;
use Password;

my $title = "セッションID管理テスト";
my $expire = "+1h";
my $encode = "UTF-8";

# データベースを使うところを省略
my %User ('hoge'=> {pass => q|$1$hEeN3T%+$CRKHRxko1cWGNjE69mTNw.|});

my $cgi = new CGI;
print $cgi->redirect( -uri=>'http://'.$ENV{SERVER_NAME}.$ENV{SCRIPT_NAME}, -status=>301) and exit if $cgi->param('CGISSID');

my $sid = $cgi->cookie('CGISESSID') || undef;

my $session = CGI::Session->load(undef, $sid, {Directory=>'./data'}) or die CGI:Session->errstr();
Error("Your session time out! Refresh the screen to start new session!") if $session->is_expired;
$session->expire($expire); #有効期限の設定
#$session->expire('+1m');

if($session-> is_empty){
	$session = $session->new(undef, $sid, {Directory=>'./data'}) or die $session->errstr;
} #取得したセッションidが有効ならそのまま、無効なら別のidを発番

my %param = $cgi->Vars();
my @message;

if ($session){
	if (my $action = $param{'action'}){
		push @message, forget() if $action eq 'forget me'; #　セッションの削除依頼
		push @message, loguout() if $action eq 'logout';  #　セッション内のログインステータスを初期化
	}

	$session->save_param($cgi); # 入力値をセッション内に保存
	$session->clear('pass'); #パスワードの平文保存を回避
	push @message, login($session->param('username'), $param{'pass'}) if $param{'action'} and $param{'action'} eq 'login';
	push @message, $session->param('username')? confirm(): ask();
} else {
	push @message, ask();
}

print $session->header ( -charset => $encode),
	start_html( -title => $title, -encoding => $encode, -lang=>'ja'),
	@message,
	a({href=>$ENV{"SCRIPT_NAME"}}, '戻る',),
	end_html(),
;

sub Error {
	my $msg = shift;

	print $session->header( -charset => encode),
	start_html( -title => "エラー / " . $title, -encoding => $encode, -lang => 'ja'),
	h1("エラー"),hr();
	p(strong($msg)),hr(),
	a({href=>$ENV{"SCRIPT_NAME"}}, '戻る',),
	end_html(),
};
exit;
}

sub forget {
	$session->clear(['username','firstname','lastname','like','action','login']);
	$session->close;
	$session->delete;
	return h2("we've forgotten you!");
}

[vagrant@localhost ~]$ cpan App::cpanminus
[vagrant@localhost ~]$ sudo yum install -y openssl openssl-devel
パッケージ openssl-1.0.1e-57.el6.x86_64 はインストール済みか最新バージョンです
パッケージ openssl-devel-1.0.1e-57.el6.x86_64 はインストール済みか最新バージョンです

[vagrant@localhost ~]$ cpanm LWP::Protocol::https
-bash: cpanm: コマンドが見つかりません
[vagrant@localhost ~]$ /usr/local/bin/cpanm LWP::Protocol::https
-bash: /usr/local/bin/cpanm: そのようなファイルやディレクトリはありません

my $url = "https://xxx.yyy.jp";
my $request = HTTP::Request->new(GET => $url);
my $ua = LWP::UserAgent->new;
my $res = $ua->request($request);
my $resutl = $res->content;

There is no problem with HTTP pages, but it fails with HTTPS.

cpan istall LWP::Protocol::https

Cpanm Crypt::SSLeay

Net::Amazon::S3 – Use the Amazon S3 – Simple Storage Service
Version 0.86

This module provides a Perlish interface to Amazon S3. From the developer blurb: “Amazon S3 is storage for Internet. It is designed to make web-scale computing easier for developers. Amazon S3 provides a simple web service interface that can be used to store and retrieve any amount of data, at any time, from anywhere on the web. It gives any developer access to the same highly scalable, reliable, fast, inexpensive data storage infrastructure that Amazon uses to run its own global network of web sites. The service aims to maximize benefits of scale and to pass those benefits on to developers”

use Net::Amazon::S3;
my $aws_access_key = 'fill me in';
my $aws_screte_access_key = 'fill me in too';

my $s3 = Net::Amazon::S3->new(
{
	aws_access_key_id => $aws_access_key_id,
	aws_secret_access_key => $aws_secret_access_key,
	use_iam_role => 1,
	retry => 1
}
);

my $response = $s3->buckets;
my $bucket( @{ $response->{buckets}})
	or die $s3->err . ": " . $s3->errstr;

$bucket = $s3->bucket($bucketname);

$bucket->add_key_filename('1.JPG', 'DSC06256.JPG',
	{ content_type => 'image/jpeg',},
) or die $s3->err . ": " . $s3->errstr;