第7章のサンプルコード
---------------------
目次（ページ番号）
■P142-1
■P142-2
■P143
■P144
■P145
■P148
■P149
■P150
■P151
■P156
■P157
■P158
■P162-1
■P162-2
■P163-1
■P163-2
■P163-3
■P164-1
■P164-2
■P165
■P168
■P169
■P170
---------------------

■P142-1
# helloサブルーチンの呼び出し
#  hello.pl

# サブルーチン呼び出し
&hello( );

# サブルーチンの定義
sub hello {
  print "こんにちは、私はサブルーチンです。\n";
}

■P142-2
# 引数を取るhello_argサブルーチンの呼び出し
#  hello_arg.pl

# サブルーチン呼び出し
&hello_arg("太郎");

# サブルーチンの定義
sub hello_arg {
  my($name) = @_;
  print "こんにちは、私は$nameです。\n";
}

■P143
# 戻り値を持つhello_retサブルーチンの呼び出し
#  hello_ret.pl

# サブルーチン呼び出し
$string = &hello_ret("花子");

# 戻り値を表示
print "戻り値: $string";

# サブルーチンの定義
sub hello_ret {
  my($name) = @_;
  # 文字列を返す
  "こんにちは、私は$nameです。\n";
}

■P144
# return関数を使って戻り値を返す
#  hello_return.pl

# サブルーチン呼び出し
$string = &hello_return("花子");

# 戻り値を表示
print "戻り値: $string";

# サブルーチンの定義
sub hello_return {
  my($name) = @_;
  # 文字列を返す
  return("こんにちは、私は$nameです。\n");
}

■P145
# ハノイの塔
#  hanoi.pl

# サブルーチン呼び出し
&hanoi(3, "左", "中", "右");

# サブルーチン本体
sub hanoi {
  my($disk, $bar1, $bar2, $bar3) = @_;
  
  # 円盤が1つ以上残っている
  if ($disk > 0) {
    # 再帰呼び出し1
    hanoi($disk - 1, $bar1, $bar3, $bar2);
    
    # 移動内容を表示
    print "円盤 $disk を $bar1 の棒から $bar2 の棒に移動。\n";
    
    # 再帰呼び出し2
    hanoi($disk - 1, $bar3, $bar2, $bar1);
  }
}

■P148
# localとmyのテスト
#  local_my.pl

# サブルーチン呼び出し
&local_my( );

# サブルーチン本体
sub local_my {
  # localによる定義
  local($local_value) = "太郎";

  # myによる定義
  my($my_value) = "花子";

  # 別サブルーチンを呼び出し
  &echo_local_my( );
}

# サブルーチンから呼び出される別ルーチン
sub echo_local_my {
  # localとmyの値を表示
  print "localによる値: $local_value\n";
  print "myによる値: $my_value\n";
}

■P149
# localで定義された変数の値を変更する
#  modify_local.pl

# サブルーチン呼び出し
&modify_local( );

# サブルーチン本体
sub modify_local {
  # ローカルで定義
  local($local_value) = "元のテキスト";
  # ローカルで定義
  my($my_value) = "元のテキスト";

  print "[実行前]\n";
  print "local:\t$local_value\n";

  print "my:\t$my_value\n";

  &change_local( );

  print "[実行後]\n";
  print "local:\t$local_value\n";
  print "my:\t$my_value\n";
}

sub change_local {
  $local_value = "変更しました。";
  $my_value = "変更しました。";
}

■P150
# ブロック内でのローカル変数の定義
#  block.pl

$variable = "グローバル";

print "サブルーチン実行前: $variable\n";

# サブルーチン呼び出し
&block( );
print "サブルーチン実行後: $variable\n";

# サブルーチン本体
sub block {
  my($variable) = "ローカル";
  print "\tブロック前: $variable\n";
  {
    my($variable) = "ブロック";
    print "\t\tブロック内: $variable\n";
  }
  print "\tブロック後: $variable\n";
}

■P151
# ourとmyのテスト
#  our_scope.pl

# グローバル変数を宣言
@global_value = (1, 2, 3);

&modify_my( );
print "[my後] ", @global_value, "\n";

&modify_our( );
print "[our後] ", @global_value, "\n";

# myによるグローバル変数の上書き
sub modify_my {
  my(@global_value);
  print "[my] ", @global_value, "\n";
  @global_value = ("A", "B", "C");
  print "[my変更] ", @global_value, "\n";
}

# ourによるグローバル変数の上書き
sub modify_our {
  our(@global_value);
  print "[our] ", @global_value, "\n";
  @global_value = ("A", "B", "C");
  print "[our変更] ", @global_value, "\n";
}

■P156
# スカラー変数のリファレンス
#  reference.pl

$string = "私は太郎です。";

# サブルーチン実行前
print "実行前: $string\n";

# リファレンスを渡してサブルーチン実行
&sub_reference(\$string);

# サブルーチン実行後
print "実行後: $string\n";

# サブルーチン
sub sub_reference {
  # リファレンスを受ける
  my($reference) = @_;

  # リファレンスのスカラー変数の内容を変更
  $$reference =~ s/太郎/花子/;
}

■P157
# 配列のリファレンス
#  reference_array.pl

@array = (1 .. 5);

# サブルーチン実行前
print "実行前: ", join(", ", @array), "\n";

# リファレンスを渡してサブルーチン実行
&sub_reference_array(\@array);

# サブルーチン実行後
print "実行後: ", join(", ", @array), "\n";

# サブルーチン
sub sub_reference_array {
  # リファレンスを受ける
  my($reference_array) = @_;

  # リファレンスの配列の内容を変更
  for ($i = 0; $i < @$reference_array; $i++) {
    $$reference_array[$i]++;
  }
}

■P158
# 無名サブルーチンで戻り値を直接取得する
#  hello_anonymous.pl

# 無名サブルーチン
$string = sub {
  # 文字列を返す
  return("こんにちは、私は$nameです。\n");
};

# 戻り値を表示
$name = "花子";
print "戻り値: ", &$string;

■P162-1
# helloライブラリ
#  hello_lib.pl

# サブルーチン定義
sub hello {
  my($name) = @_;
  print "こんにちは、$nameさん。\n";
}

# 戻り値
1;

■P162-2
# hello_libの呼び出し
#  hello_call.pl

# ライブラリの呼び出し
require("hello_lib.pl");

# サブルーチンの呼び出し
&hello("太郎");

■P163-1
# 設定ファイルを読み込む
#  config_load.pl

# 初期値
$name = "匿名";

# ファイルの存在チェック
if (-r "config") {
  require("config");
}

print "こんにちは、$nameさん。\n";

■P163-2
# 設定ファイル
#  config

$name = "太郎";
1;

■P163-3
# BEGINとENDのテスト
#  begin_end.pm

# BEGINルーチン
BEGIN {
  print "モジュールを開始しました。\n";
}

# ENDルーチン
END {
  print "モジュールを終了しました。\n";
}

1;

■P164-1
# begin_endモジュールを読み込む
#  begin_end_call.pl

print "モジュール呼び出し前\n";

# モジュール呼び出し
use begin_end;
print "メインルーチンの終了\n";

■P164-2
# パッケージ化したhelloモジュール
#  hello_package.pm

# helloという名前でパッケージを定義
package hello;

# このサブルーチンはhello::helloとして呼び出す
sub hello {
  my($name) = @_;
  print "こんにちは、$nameさん。\n";
}

1;

■P165
# hello_packageを呼び出す
#  hello_package_call.pl

# パッケージ呼び出し
use hello_package;

# パッケージ名を付けずに呼び出し
&hello("太郎");

# パッケージ名を付けて呼び出し
&hello::hello("太郎");

# 同名のサブルーチンを定義
sub hello {
  my($name) = @_;
  print "さようなら、$nameさん。\n";
}

■P168
# File::Copyを使ってファイルをコピー
#  copy.pl

# モジュール呼び出し
use File::Copy;

if (@ARGV != 2) {
  # 引数が2つ以外のときには使い方を表示
  &usage( );
}

# モジュールのルーチンを実行
copy($ARGV[0], $ARGV[1]);

print "コピー中にエラーが発生しました($!)。\n" if ($!);

# 使い方を表示
sub usage {
  print <<EOT
copy.pl: ファイルのコピー

 copy.pl コピー元ファイル名  コピー先ファイル名
EOT
  ;
  exit(1);
}

■P169
# ベンチマーク
#  benchmark.pl

# モジュール呼び出し
use Benchmark;

# 1つ目のベンチマークオブジェクト
$before_time = new Benchmark;

# 50000カウントの計算
&recursive(50000);

# 2つ目のベンチマークオブジェクト
$after_time = new Benchmark;

# 2つのベンチマークから結果を求める
$diff = timediff($after_time, $before_time);

# 表示
print "結果: ", timestr($diff), "\n";

# 時間を計測するための再帰呼び出し
sub recursive {
  my($number) = @_;

  # 1つずつカウンタを減らして0になるまで再帰呼び出しを行う
  &recursive(--$number) if ($number);
}

■P170
# UTF-8の変数名を使う
#  utf8_consumption_duty.pl

# モジュール呼び出し
use utf8;

$消費税率 = 0.05;

print "subtotal: ";

$小計金額 = <STDIN>;
chomp($小計金額);

$消費税額 = $小計金額 * $消費税率;

$合計金額 = $小計金額 + $消費税額;

print "tax: ${消費税額} yen\n";
print "total amount: ${合計金額} yen\n";
