#!/usr/local/bin/perl
use strict;
use warnings;
use utf8;
use open ":utf8";
use Data::Dumper;
print "Content-type: text/html; charset=utf-8\n\n";
print "\n";
print "\n";
print "\n";
print "CGI test\n";
print "\n";
print "\n";
# ex_hairetsu0.txt
print "-------通常の配列------
\n";
# =============== 通常の配列 ================
#----配列作成（その１）----
my($a1,$a2,$a3)=(1,2,3);
my @x =("apple", "orange");
my($a4,$a5) = @x;
my @y = ($a1,$a2,$a3,$a4,$a5);
print "\@y = @y
\n";
print "表示１ \$a1 = $a1 \$a2 = $a2 \$a3= $a3 \$a4 = $a4 \$a5 = $a5
\n";
print "表示２ \$a1 = $y[0] \$a2 = $y[1] \$a3= $y[2] \$a4 = $y[3] \$a5 = $y[4]
\n";
#要素交換
($a1,$a2,$a3,$a4,$a5) = ($a1,$a5,$a2,$a3,$a4);
print "\$a1 = $a1 \$a2 = $a2 \$a3= $a3 \$a4 = $a4 \$a5 = $a5
\n";
@y =($a1,$a2,$a3,$a4,$a5);
#配列末尾の要素の添え字は、$#変数名という変数で表す
print "配列末尾の要素: $y[$#y]
\n";
# 配列の個数
my $y_num = @y;
print "配列の個数: $y_num
\n";
#スライス利用？？？
# 指定場所出力
print "指定場所出力: @y[1,2,4]
\n"; #1,2,4番目出力
# 入れ替え
print "入れ替え前 \$a1 = $y[0] \$a2 = $y[1] \$a3= $y[2] \$a4 = $y[3] \$a5 = $y[4]
\n";
@y[0,2,4] = @y[4,3,1];
print "入れ替え後 \$a1 = $y[0] \$a2 = $y[1] \$a3= $y[2] \$a4 = $y[3] \$a5 = $y[4]
\n";
# 同じ値
@y[0,1,3] = @y[4,4,4];
print "同じ値 \$a1 = $y[0] \$a2 = $y[1] \$a3= $y[2] \$a4 = $y[3] \$a5 = $y[4]
\n";
#値を置き換える
@y[0,2,4] = qw/pink gray green /;
print "置き換え \$a1 = $y[0] \$a2 = $y[1] \$a3= $y[2] \$a4 = $y[3] \$a5 = $y[4]
\n";
# 要素の末尾に追加（その１）
@y = (@y, "banana");
print "\@y = @y
\n";
# 要素の末尾に追加（その２）
#push (@y, "grape");
push @y, "grape";
print "push使用: @y
\n";
#----配列作成（その２）----
my @colour;
$colour[0] ="blue";
$colour[1] ="red";
$colour[2] ="yellow";
print "\@colour = @colour
\n";
#----配列作成（その３）----
#配列を作るのにqw(クォート構文 )を使う。
#各要素の間は、空白以外に、タブや改行でも良い
#クォート構文の場合、上記のように ( ) ばかりではなく、他の記号（ !, /, #, { }, [ ] など可能 ）
my @languages = qw(Perl awk C C++ Ruby Python);
print "\@languages： @languages
\n";
#計算
my @xx = (1, 2, 3);
my $aa = $xx[0] + $xx[1] + $xx[2];
print "\@xx= @xx \$aa = $aa
\n";
$xx[1] += 10;
print "\$xx[1]= $xx[1]
\n";
my $dd0 = \@xx; #xへのリファレンス
$dd0->[0] += 10;
print "\$dd0->[0] = $dd0->[0]
\n";
print "\@xx = @xx
\n";
foreach my $xx (@xx) {
print $xx,"\n";
}
print "
\n";
print "-------通常のハッシュ------
\n";
# =============== 通常のハッシュ ================
#連想配列（ハッシュ）：配列の添え字にキー（文字列）を使う事ができる。
#連想配列の作り方1
my %address = (
"鈴木" , "東京都千代田区",
"山田" , "東京都葛飾区",
"本田" , "愛知県名古屋市",
"遠藤" , "大阪府堺市");
#連想配列の作り方２
my %tr_signal;
$tr_signal{"red"} = "stop";
$tr_signal{"yellow"} = "low speed";
$tr_signal{"blue"} = "go";
#連想配列の作り方３
my %flower;
@flower{'red','yellow','violet','pink'} = ('camellia','sunflower','wisteria','cherry');
#連想配列の作り方4
#引用符なしで文字列リテラルのリストを書きたいときには，qw( ) で括る
my %fruit;
@fruit{ qw(red yellow violet) } = qw(apple banana grape);
#@fruit{ qw[red yellow violet] } = qw/apple banana grape/;
#@fruit{ qw[red yellow violet] } = ('apple','banana','grape');
#配列の作り方5
#ハッシュの作り方
my @keys7 = ("山", "b", "川"); # キー
my @values7 = (1, "魚", 3); # 要素
my %hash7;
@hash7{@keys7} = @values7;
#キー： b 要素： 魚
#キー： 川 要素： 3
#キー： 山 要素： 1
#連想配列の作り方6
#my %hh = ('name' => 'Taro', 'age' => 20, 'height' => 175);
#「キー」の文字列が全て「英数字・アンダースコア」の場合には、クォーテーションによる括りを省略出来る
my %hh = (name => 'Taro', age => 20, height => 175);
print "\$hh{name} = ",$hh{name},"
\n";
print "\$hh{'name'} = ",$hh{'name'},"
\n";
#加算
$hh{'height'} += 1;
#値を元にキーを取り出す事は出来ない
print "これは不可：$fruit{'banana'}
\n";
print "ハッシュ変更前
\n";
foreach my $tmp ( keys %hh ) {
print "$tmp $hh{$tmp}
\n";
}
print "ハッシュ変更後
\n";
$hh{name} = 'jiro'; #１つ変更
@hh{ qw/age height/} = (33,165); #複数変更
$hh{weight} = 60; #追加
for( keys %hh ) {
print "$_ : $hh{$_}
\n";
}
#ハッシュに対し、指定した複数のキーに対応する値たちを取得する方法。
# name weightの値を取り出す
my @data = @hh{ qw(name weight) };
print "値を取り出した値 name weight : @data
\n";
print "----------
\n";
#「keys」 は、すべてのキーの値を取り出す
my @keylist = keys(%hh); # ハッシュのキーのリスト
print "キーのリストは、@keylist
\n";
print "$keylist[0]\n
";
print "$hh{$keylist[0]}
\n";
print "$hh{name}
\n";
#「keys」 は、ハッシュの要素（キー）の数を取り出す
my $array_no = keys(%hh); # ハッシュの要素の個数
print "要素数は $array_no です。
\n";
#「values」 は、すべての要素の値を取り出す
my @elementlist = values %hh;
print "要素のリストは、@elementlist
\n";
#全体表示
print "---- ハッシュ 全て表示 その１ ---
\n";
print %hh,"
\n";
for( keys %hh ) {
print "$_ : $hh{$_}
\n";
}
print "---- ハッシュ 全て表示 その2 ---
\n";
foreach my $tmp ( keys %hh ) {
print "$tmp $hh{$tmp}
\n";
}
print "---- ハッシュ 全て表示 その3 ---
\n";
for (my $i = 0; $i < $array_no; $i++){
print "キー： $keylist[$i] 要素： $hh{$keylist[$i]}
\n";
}
print "---- ハッシュ 全て表示 その4---
\n";
#「each」 は、１組のキーと要素を取り出す。
while ( my ($key, $val) = each %hh ) {
print "キー： $key 要素： $val
\n";
}
#ダンプ
print "=== data dump ===
\n";
print Data::Dumper->Dump([\%hh], ['*hh']);
print "
\n";
# 生徒の数学の点数
my %math_scores = (
Aiko => 89,
Kenta => 100,
Taro => 34,
);
#ハッシュスライス
print "----ハッシュスライス----
\n";
print "ハッシュ変更前
\n";
foreach my $tmp ( keys %hh ) {
print "$tmp $hh{$tmp}
\n";
}
print "ハッシュ変更後
\n";
$hh{name} = 'jiro'; #１つ変更
@hh{ qw/age height/} = (33,165); #複数変更
$hh{weight} = 60; #追加
for( keys %hh ) {
print "$_ : $hh{$_}
\n";
}
my @hh_slice = @hh{qw(name age)}; #name とage の値を取得する
print @hh_slice,"
\n";
print "\@hh_slice = (", join(', ', @hh_slice), ")
\n";
@data = @hh{ qw(name weight) }; # name weightの値を取り出す
print "値を取り出した値 name weightは @data
\n";
print "-------無名配列---------
\n";
# =============== 無名配列 ================
#[ ] は、無名配列を作る記号
my $xx1 = [10, 20, 30, 40];
my $aa1 = $xx1->[0] + $xx1->[1] + $xx1->[2];
# 値を取り出す時、$xx1->[1]
print "\$xx1= @$xx1 \$aa1 = $aa1
\n";
$xx1->[1] += 10;
$$xx1[1] += 3;
print "\$xx1->[1] = $xx1->[1]
\n"; #$xx1->[1] = 33
print "\$\$xx1[1] = $$xx1[1]
\n"; #$xx1[1] = 33
print "出力方法1
\n";
foreach my $item (@{$xx1}) { #@{$xx1} = @$xx1
print $item, "\n";
}
print "出力方法2
\n";
foreach my $item (@$xx1) { #@{$xx1} = @$xx1
print $item, "\n";
}
print "
\n";
print "出力方法３
\n";
for (my $i = 0; $i < 4; ++$i) { # 無名配列の各要素を添え字で指定
print $xx1->[$i], "\n"; #$xx1->[ ]
# print $$xx1[$i], "\n"; # $$xx1[$i]
}
print "
\n";
# =============== 無名のハッシュ ================
#my $hh1 = {'name' => 'Taro', 'age' => 20, 'height' => 175};
my $hh1 = {'name' , 'Taro', 'age' ,20, 'height', 175};
#加算方法
$hh1->{'height'} += 1;
$$hh1{'height'} += 1;
# 値を取り出す時、$xx1->[1]
print "$hh1->{'height'}
\n";
print "$$hh1{'height'}
\n";
print "---- 無名ハッシュ出力 その１ ----
\n";
while ( my ($key, $val) = each %$hh1 ) {
print "$key : $val \n";
}
print "
---- 無名ハッシュ出力 その２ ----
\n";
for( keys %$hh1 ) {
print "$_ : $hh1->{$_} \n";
}
print "
\n";
my @double_val = ($hh1->{age}, $hh1->{height});
print join(', ', @double_val);
print "
\n";
# スライスを用いる方法。
my @double_val0 = @{$hh1}{qw/age height/};
print join(', ', @double_val0);
print "
\n";
# リファレンスとは、変数が格納されているエリアの参照値（アドレス値）。
# Ｃ言語でいう、ポインターとほぼ同じ概念。
# 変数のリファレンスを求めるには、変数の前に『\』を付ける。
# 逆にリファレンスが指すエリアに格納されている値を取得することをデリファレンスといいう。
# リファレンスからデリファレンスを求めるのは、変数のタイプ応じて、前に『$,@,%』のいずれかを付ける。
#====スカラー変数のリファレンスとデリファレンス====
print "-------スカラー変数のリファレンスとデリファレンス-------
\n";
my $word = "A";
my $ref_scalar = \$word; # $wordのリファレンス
print "変数の値： ",$word, "
\n";
print "リファレンス： ",$ref_scalar, "
\n";
print "デリファレンス： ", $$ref_scalar, "
\n";#デリファレンス
# デリファレンスは$をつける。(スカラーである変数の要素の値をもとめる)
print "
\n";
print "-------配列変数のリファレンスとデリファレンス-------
\n";
my @word = ("X", "Y", "Z");
my $ref_array = \@word; # @wordのリファレンス
print "リファレンス： ", $ref_array, "
\n";
print "配列変数の値: ",@word,"
\n";
print "デリファレンス 表記1: ",@$ref_array,"
\n";
print "デリファレンス 表記2: ",@{$ref_array},"
\n";
print "----配列変数の要素の値をもとめる---
\n";
print "要素1番の値：",$word[1], "
\n";
print "要素1番の値：",@$ref_array[1],"
\n"; #?????
print "要素1番の値：",$$ref_array[1],"
\n";
print "要素1番の値：",${$ref_array}[1],"
\n";
print "要素1番の値：",$ref_array->[1],"
\n";
print "-------ハッシュ変数のリファレンスとデリファレンス-------
\n";
my %word = ("aaa", "X", "bbb", "Y", "ccc", "Z");
my $ref_hash = \%word; # %wordのリファレンス
print "ハッシュ変数の値： ",%word, "
\n";
print "リファレンス： ",$ref_hash,"
\n";
print "デリファレンス 表記1: ",%$ref_hash,"
\n";
# ハッシュ変数の要素の値をもとめるには、$を付ける。
print "要素\"bbb\"の値：",$word{"bbb"}, "
\n";
print "要素\"bbb\"の値：",@$ref_hash{"bbb"}, "
\n"; #?????
print "要素\"bbb\"の値：",$$ref_hash{"bbb"}, "
\n";
print "要素\"bbb\"の値：",${$ref_hash}{"bbb"}, "
\n";
print "要素\"bbb\"の値：",$ref_hash->{"bbb"}, "
\n";
#============================================
print "
\n";
##「配列」から「ハッシュ」をつくる。
my @c = ('xx', 'X1', 'yy', 'Y1', 'zz', 'Z1'); # 配列
my %d = @c; # 配列を、ハッシュにコピー
print "##配列から無名配列を作る その１
\n";
my $c_ref = \@c; # 普通にリファレンス取得
print Dumper $c_ref,"\n";
print "
\n";
print "##配列から無名配列を作る その２
\n";
my $d_ref = [@c]; # 無名配列を作り出す [ ]
print Dumper $c_ref,"\n";
print "
\n";
print "##「配列」から「無名ハッシュ」を作り出す
\n";
my $h_ref = {@c}; # 無名ハッシュを作り出す { }
print Dumper $h_ref,"\n";
print "
\n";
print "##、「ハッシュ」から「無名ハッシュ」
\n";
my $h1_ref = {%d}; # 無名ハッシュを作り出す { }
print Dumper $h1_ref,"\n";
print "
\n";
print "
---Dumper 使用---
\n";
print "レファレンス：",Dumper \@c,"
\n";
print "----------
\n";
print "",Dumper @c,"
\n";
print "----------
\n";
print Dumper \%d,"
\n";
print "----------
\n";
print Dumper %d,"
\n";
print "
\n";
#--------------------------------------------
# サブルーチンへの値の渡し
my @tmp_array = (1, 3, 5, 7, 9);
#配列へのリファレンスを受け取る
print "Total: ", compute_sum(\@tmp_array), "
\n";
sub compute_sum {
my ($aref) = @_; # リファレンスを$aref へ代入
my $sum = 0;
foreach (@$aref) { # 配列をデリファレンス
$sum += $_;
}
return $sum;
}
print "------
\n";
#通常の方は、同じ変数名を使うと上書きされます。無名～は、変数名っぽいものは仮の名で、毎回メモリに領域を確保されます。
my @xx2 = (10, 20, 30);
my $data1 = \@xx2; #xへのリファレンス
@xx2 = (20, 40, 60); #配列xを上書きしています！
my $data2 = \@xx2; #xへのリファレンス
print "--------配列へのレファレンスは、メモリに上書きされる----------
\n";
print $data1->[0],"
\n"; #配列xの[0]番目は・・・ 20
print $data2->[0],"
\n"; #配列xの[0]番目は・・・ 20
#無名配列
my $xx3 = [10, 20, 30];
$data1 = $xx3;
$xx3 = [20, 40, 60]; #無名配列は都度、メモリに領域を確保
$data2 = $xx3;
print "--------無名配列は、消去されずに、メモリに領域を確保----------
\n";
print $data1->[0],"
\n"; # 10
print $data2->[0],"
\n"; # 10
print $$data2[0],"
\n"; # 10
print "------------------
\n";
print "\n";
print "\n";