perl use constant

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]], ".\";

perl sendmail

#!/usr/bin/perl

require 'getformdata.pl';

# sendmailパス
$sendmail = '/usr/sbin/sendmail';

# フォームデータの取得
%form = plab::getformdata();

# 個々の変数にコピー
$name = $form{'name'};
$from = $form{'from'};
$subject = $form{'subject'};
$message = $form{'message'};

# メールの送信先は固定
$to = 'hoge@gmail.org';

# Fromメールアドレスが空だとエラーになるので、
# 空なら仮に送信先アドレスを入れる
if($from eq ""){
	$from = $to;
}

# sendmailを書き込みオープンする
if(! open(MAIL, "|$sendmail -t")){
	# sendmailの起動ができませんでした
	print "Content-type: text/html\n";
	print "\n";
	print "メール送信に失敗しました。";

	# CGI終了
	exit;	
}

# チェック
$name =~ s/\r|\n//g;
$from =~ s/\r|\n//g;
$to =~ s/\r|\n//g;
$subject =~ s/\r|\n//g;

# ヒアドキュメントを作る
$mailtext = <<"EOM";
From: $name<$from>
To: <$to>
Subject: $subject
Content-Transfer-Encoding: 7bit
Content-Type: text/plain; charset="ISO-2022-JP"

$message
EOM

# パイプを通してsendmailにデータを渡す
print MAIL $mailtext;

close MAIL;
print "Content-type: text/html\n";
print "\n";
print "メールを送信しました。ありがとうございました";

exit;

sendmailはperlと関係なくメール送信プログラム

shell, perlとphpの比較演算子

Perl
———————————
数値比較
> : より大きい
>= : より大きいか等しい
< : より小さい <= : より小さいか等しい == : 等しい != : 等しくない <=> : 比較

文字列比較
gt: より大きい
ge: より大きいか等しい
lt: より小さい
le: より小さいか等しい
eq: 等しい
ne: 等しくない
cmp: 比較

PHP
———————————
== : 等しい
=== : 同じ
!= : 等しくない
!=== : 同じでない
> : より大きい
< : より小さい >= : 以上
<= : 以下 <=> : より小さい等しいより多き

ん?なんだこの<=>って??あんまり見ないけど。

Shell
———————————
eq : equal to
ge : greater than or equal to
gt : greater than
le : less than or equal to
lt : less than
ne : not equal to

シェルは文字列か。なんか注意が必要ですな

error handling

General method for error handling

if(env.IsDevelopment()){
	app.UseDeveloperExceptionPage();
} else {
	app.UseExceptionHandler("/Error");
	app.UseHsts();
}

SessionManager type

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.

”use CGI;” or “use CGI qw(:standard);”, what does it mean?

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);

Perl session

#! /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!");
}

cpanm Net::Amazon::S3@0.86

[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: そのようなファイルやディレクトリはありません

LWP::Protocol::https

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-0.86

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;