ϿC
---------------------
ܼ
1.1
1.2
1.3
1.4
2.1
2.2
2.3
2.4
2.5
3.1
3.2
3.3
3.4
3.5
4.1
4.2
4.3
4.4
4.5
5.1
5.2
5.3
6.1
6.2
6.3
6.4
7.1
7.2
7.3
7.4
7.5
8.1
8.2
8.3
8.4
8.5
9.1
10.1
10.2
10.3
11.1
11.2
11.3
11.4
---------------------

1.1
1.	̤-0.123ɽ륹ץȤľܥޥɥ饤˵ҤƼ¹ԤʤޤƱư򤹤륹ץȥեƼ¹Ԥʤ

ޥɥ饤:
perl -e 'print -0.123;'

ץ:
print -0.123;

2.	Υץȥեưޤ

print 1
23;


顼ˤʤޤ1231ĤΥץͤȸʤޤץͤǥڡƤϤޤ

3.	Υץȥեưޤ

print 123,45,
678;


ưޤ,פʣΥץڤ뤿˻Ȥ뵭ǤΤǡ12345678Ȥ3ĤͤꤷΤȸʤޤ,פˤϥڡ뤳ȤǤޤ

1.2
1.	ѿ$nameˤʤ̾졢ɽǲԤ륹ץȤʤ

$name = "Yamada Taro";
print "$name\n";

2.	ΥץȤ¹ԤȤɤΤ褦ʷ̤ޤ

$hex = "\x2a";
$abc = "ABC";
$quote = '\n';
print "$hex$quote$abc\n";

*\nABCɽޤ$quote'\n'ñǰϤޤƤ뤿ᡢΤޤޤʸȤưޤͤϤΤȤŰǰϤޤƤѤ뤳ȤϤޤ

3.	ΥץȤHello, Tarokun.פɽ褦˽ʤ

$hello = "Hello";
$name = "Taro";
print "$hello,$namekun\n";


Τ褦˽ޤ

$hello = "Hello";
$name = "Taro";
print "$hello,${name}kun\n";

,פѿ̾ˤϻȤʤʸʤΤǡ$hello{ }ǰϤɬפϤޤ

4.	ΥץȤqqȤäƽ񤭴ʤ

print "Ű \"\"  \\\"\\\" Ǽޤ\"ˤ\"\n";


Τ褦ˤޤ

print qq/Ű ""  \\"\\" Ǽޤ"ˤ"\n/;

1.3
1.	ޤǾҲ𤷤ץȤ˥Ȥդʤ

ʾά

2.	ΥץȤ¹ԤȤɤΤ褦ʷ̤ˤʤޤ

print 12,
# 34,
56, "\n";


ư1256ɽޤ

1.4
1.	桼̡̾Ϥ塢֤ˤϡ桼̾󡣡פȰ֤ץȤʤ̾δ֤ˤϥڡʤȤȤޤ
	# ̾Ϥơ֤ץ
#  hello2.pl

# 
print "ʤϲǤ: ";
# 桼ϤԤ
$surname = <STDIN>;
# ʸ
chomp($surname);

# ̾
print "ʤ̾ϲǤ: ";
# 桼ϤԤ
$firstname = <STDIN>;
# ʸ
chomp($firstname);

# ɽ
print "ˤϡ$surname$firstname \n";

2.	֤󤴡פѸǲȸƤ֤appleˤȤ򤷤ơ桼Ϥ򤫤ɤˤäưۤʤåɽ륹ץȤʤ
	# 󤴤αѸ̾Υץ
#  quiz2.pl

print "֤󤴡פϱѸǲȸƤӤޤ: ";
# 桼ϤԤ
$answer = <STDIN>;
# ʸ
chomp($answer);

# ʬ
if ($answer eq "apple") {
  # eqʸȤ̣
  # "apple"Ȥ
  print "Ǥ!\n";
} else {
  # "apple"ʤäȤ
  print "ͤ󡢤ϤǤ\n";
}

2.1
1.	ΥץȤ¹ԤȤɤΤ褦ʷ̤ɽޤ

# ʸޤ
#  mix_number.pl

print (("20a1" + 5 . 1), "\n");


251
ޤʸ20a1פϿ20ǧޤ5û25Ȥʤä塢.ױ黻Ҥ1ʸȤϢ뤵Ƥޤ

2.	*ȤʸΨɤ100ɽ륹ץȤʤ

# *100ʸɽ
# asterisk.pl

print "*" x 100, "\n";

3.	μη׻̤ɽ륹ץȤʤ

 1

 2       102
    
3 + 1     210


# μ¹
#  equation.pl

print ((1 / 2 / (3 + 1) * 10 * 2 / (-2 - 10)), "\n");

4.	ΥץȤ¹ԤȤɤΤ褦ʷ̤ɽޤ

# ͥ
#  minus.pl

$number = -2 ** 4;
print "-2 ** 4 = $number\n";


-2 ** 4 = -16
߾ñޥʥͥ褵ޤΤᡢ-24ǤϤʤ24Ԥä塢ͤФñޥʥ¹Ԥޤ

2.2
1.	ΥץȤβû򥤥󥯥ȱ黻Ҥǥȱ黻Ҥ֤ʤ

# 󥯥ȱ黻ҤѤƤʤץ
#  replace_original.pl

$number1 = 0;
$number2 = 0;

$number1 = $number1 + 1;
$number2 = $number1;

# ɽ
print "󥯥:\t1: $number1 2: $number2\n";

$number2 = $number1;
$number1 -= 1;

# ɽ
print "ǥ:\t1: $number1 2: $number2\n";


# 󥯥/ǥȱ黻Ҥ֤ץ
#  replace_increment.pl

$number1 = 0;
$number2 = 0;

$number2 = ++$number1;

# ɽ
print "󥯥:\t1: $number1 2: $number2\n";

$number2 = $number1--;

# ɽ
print "ǥ:\t1: $number1 2: $number2\n";

2.	ΥץȤ¹ԤȡɤΤ褦ʷ̤ɽޤ

# 󥯥ȱ黻ҤΥƥ
#  increment.pl

$number1 = 1;
$number2 = $number1++;
$number3 = ++$number1;

print "N1:$number1, N2:$number2, N3:$number3\n";


N1:3, N2:1, N3:3
$number1ϡ2ܤͤ$number2Ȥǥ󥯥Ȥ2ˤʤޤ3ܤǤϡ$number1󥯥Ȥ3ˤʤäȡ$number3ͤޤ

2.3
1.	210Ȥ2ĤͤФơ<黻Ҥ¹ԤȤlt黻Ҥ¹ԤȤΰ㤤Ĵ٤륹ץȤʤ

# <黻Ҥlt黻Ҥΰ㤤
#  smaller_and_lt.pl

# <黻
print "<黻Ҥˤɾ\n";
if (2 < 10) {
  print "210礭\n";
} else {
  print "102礭\n";
}

# lt黻
print "lt黻Ҥˤɾ\n";
if (2 lt 10) {
  print "210礭\n";
} else {
  print "102礭\n";
}

ΥץȤμ¹Է̤ϼΤȤǤ

<黻Ҥˤɾ
210礭
lt黻Ҥˤɾ
102礭

<黻ҤϿͤ羮lt黻Ҥʸɤ羮ȤɾԤޤlt黻Ҥˤɾ102礭פȤʤΤϡǽΥޥå󥰤ǡ2פȡ1פӤ졢2ʸɤ礭ȽǤ뤿Ǥ

2.	Ϥ줿ʸˡڡפȤñ줬äƤʤȤǧ륹ץȤʤ

# ѥޥå
#  antipattern.pl

print "ʤ̾ϲǤ: ";
$string = <STDIN>;
chomp($string);

# ʸˡڡפޤޤƤʤȤĴ٤
if ($string !~ //) {
  print "ˤϡ\n";
} else {
  print "ڤϥǤޤ\n";
}

2.4
1.	2ĤͤϤȡ¤ɽ륹ץȤ黻ҤȤäƺʤ
	# 2ͤ
#  logical_or.pl

print "1ܤοͤϤƤ: ";
$number1 = <STDIN>;
chomp($number1);
print "2ܤοͤϤƤ: ";
$number2 = <STDIN>;
chomp($number2);

# ʸͤˤ
$number1 += 0;
$number2 += 0;

# ¤
$number1 |= $number2;

print ": $number1\n"

2.	桼̾ȥѥɤϤ׵ᤷ桼̾SECRETUSERѥɤSECRETȹפСǧڤޤסɤ餫פʤäֵݤޤפɽ륹ץȤʤ

# 桼̾ȥѥɤǧ
#  login.pl

print "桼̾ϤƤ: ";
$username = <STDIN>;
chomp($username);
print "ѥɤϤƤ: ";
$password = <STDIN>;
chomp($password);

# Ƚ
if ($username eq "SECRETUSER" && $password eq "SECRET") {
  print "ǧڤޤ\n";
} else {
  print "ݤޤ\n";
}

3.	2ĤͤϤꡢͤ5礭Ʊ1ܤͤ2ܤͤ礭СֿǤסǤʤСֵǤפɽ륹ץȤʤ

# û黻Ҥ2ͤ3ĤӤ
#  multiple_shortcut.pl

print "1ܤοͤϤƤ: ";
$number1 = <STDIN>;
chomp($number1);
print "2ܤοͤϤƤ: ";
$number2 = <STDIN>;
chomp($number2);

# Ӥ
if ($number1 > 5 && $number2 > 5 && $number1 > $number2) {
  print "Ǥ\n";
} else {
  print "Ǥ\n";
}

2.5
1.	ҥ黻ҤȤȡ'פ"פɽΤ˥ץ󥹤ȤɬפʤȤΤʤ

# '"ҥ黻ҤǻȤ
#  here5.pl

print <<EOT
  ñ '
  Ű "
EOT
  ;

ΥץȤμ¹Է̤ϼΤ褦ˤʤޤʥץ󥹤ꤷʤƤ⡢ɽ뤳ȤǧǤޤˡ

  ñ '
  Ű "

2.	ҥ黻Ҥʸꡢ5󷫤֤ɽ륹ץȤʤ

# ҥ黻Ҥʸ򷫤֤
#  here6.pl

$name = "ڤ";

print <<"EOT"
ˤϡ$name
Фϡ$name
EOT
x 5;

3.1
1.	2Ĥͤȵ+-*/ˤϤȡͤꤷǷ׻륹ץȤʤ

# ׻ץ
#  calc.pl

print "1: ";
$value1 = <STDIN>;
print "2: ";
$value2 = <STDIN>;
print "׻(+,-,*,/): ";
$calc = <STDIN>;
chomp($value1, $value2, $calc);

if ($calc eq "+") {
  # û
  $return = $value1 + $value2;
} elsif ($calc eq "-") {
  # 
  $return = $value1 - $value2;
} elsif ($calc eq "*") {
  # 軻
  $return = $value1 * $value2;
} elsif ($calc eq "/") {
  # 
  unless ($value2 == 0) {
    $return = $value1 / $value2;
  } else {
    # 0 ˤ
    $return = "0 ǽ褦Ȥޤ";
  }
} else {
  # ɤǤʤäȤ
  $return = "̵ʷ׻ƤǤ";
}

# ɽ
print "׻: $return\n";

2.	ΥѥǧڥץȤunlessơȥȤǽ񤭴ʤ

# ѥǧڥץ
#  password.pl

print "ѥɤ: ";
$password = <STDIN>;
chomp($password);

if ($password eq "SECRET") {
  print "ǧڤޤ\n";
} else {
  print "ǧڤ˼Ԥޤ\n";
}


# ѥǧڥץ
#  password_unless.pl

print "ѥɤ: ";
$password = <STDIN>;
chomp($password);

unless ($password ne "SECRET") {
  print "ǧڤޤ\n";
} else {
  print "ǧڤ˼Ԥޤ\n";
}

3.	ΥץȤ¹ԤȡɤΤ褦ʷ̤ɽޤ

# unlessư
#  unless.pl

$number1 = 2;
$number2 = 1;
unless ($number1 == 2 || $number2 != 1) {
  print "OR\n";
}
unless ($number1 == 2 && $number2 != 1) {
  print "AND\n";
} 


AND
	ifʸ٤Ƥ䤳ޤunlessϼη̤ΤȤ˼¹ԤȤȤФƤǤϤǤ

3.2
1.	ΥץȤ¹Ԥ2ϤȡɤΤ褦ʷ̤ɽޤ

# ܡ׻
#  double.pl

print "ͤϤƤ: ";
$number = <STDIN>;
chomp($number);

until ($number > 16) {
  print ": $number\n";
  $number += $number;
}


: 2
: 4
: 8
: 16	

2.	SECRETפϤޤǡ֥ѥɤϤƤ:פȷ֤ɽơ桼Ϥ׵᤹륹ץȤʤ

# ѥɤ䤤碌
#  secret.pl

do {
  print "ѥɤϤƤ: ";
  $password = <STDIN>;
  chomp($password);
} until ($password eq "SECRET");

	do-whileȤäƵҤ뤳ȤǤޤ

3.	do-untilơȥȤȤäơꤷ10ʿ2ʿѴ륹ץȤʤ2ʿȤϡ01ɽͤΤȤǤȤ2ʿΡ10פ10ʿΡ2פ̣2ʿΡ1011פ10ʿΡ11פ̣ޤ

ҥ ͤ2ǳäȤ;ͤǼƤ顢ͤ2ǳäȤξƤӥƥȤޤ򾦤1꾮ʤޤǷ֤ޤ


# 10ʿ2ʿѴ
#  bit.pl

print "10ʿοͤꤷƤ: ";
$number = <STDIN>;
chomp($number);

$bin = '';

do {
  # 2ǳä;
  $bin = ($number % 2) . $bin;
  # $number2ǳ
  $number /= 2;
  # $number1꾮ʤޤǷ֤
} until ($number < 1);

print "2ʿ: $bin\n";

3.3
1.	ΥץȤforơȥȤȤäƽ񤭴ʤ

# ǥ
#  decrement_until.pl

print "ͤϤƤ: ";
$number = <STDIN>;
chomp($number);

until ($number < 0) {
  print ": $number\n";
  $number--;
}


# ǥ
#  decrement_for.pl

print "ͤϤƤ: ";
$number = <STDIN>;
chomp($number);

for ($i = $number; $i >= 0; $i--) {
  print ": $number\n";
  $number--;
}

2.	ꤷͤޤǤο򥫥Ȥ륹ץȤʤ413ɽʤ褦ˤʤ

# ꤷޤɽ413Ф
#  for_skip4_13.pl

print "ͤϤƤ: ";
$max = <STDIN>;
chomp($max);

for ($number = 1; $number <= $max; $number++) {
  if ($number == 4 || $number == 13) {
    # $number413ΤȤˤ1ĥ󥯥
    $number++;
  }
  print ": $number\n";
}

3.	1ͤ2ܤĤƤ64ˤʤޤɽ륹ץȤʤ

# 164ޤܿɽ
#  for_double.pl

for ($number = 1; $number <= 64; $number *= 2) {
  print ": $number\n";
}

3.4
1.	ꤷͤޤǤο򥫥Ȥ륹ץȤʤnextơȥȤȤäơ413ɽʤ褦ˤʤ

# ꤷޤɽnextȤä413Ф
#  next_skip4_13.pl

print "ͤϤƤ: ";
$max = <STDIN>;
chomp($max);

for ($number = 1; $number <= $max; $number++) {
  if ($number == 4 || $number == 13) {
    # $number413ΤȤˤnext¹
    next;
  }
  print ": $number\n";
}

2.	ΥץȤ¹ԤȡɤΤ褦ʷ̤ɽޤ

# ٥Ȥä롼
#  label2.pl
LP1: for ($i=0; $i<=5; $i++) {
  LP2: for ($j = 0; $j <= $i; $j++) {
    if ($i == 2 && $j == 2) {
      print " [IF] ";
      $i += 2;
      redo LP1;
    }
     print "$j-";
  }
  print "\n";
}


0-
0-1-
0-1- [IF] 0-1-2-3-4-
0-1-2-3-4-5-

3.5
1.	Ϥ줿ʸSECRETСǧڤޤסʳǤСǧڤ˼ԤޤפɽѥǧڥץȤ?黻ҤȤäƺʤ

# ?黻Ҥˤѥǧڥץ
#  password.pl

print "ѥɤ: ";
$password = <STDIN>;
chomp($password);

print (($password eq  "SECRET") ?
  "ǧڤޤ\n" : "ǧڤ˼Ԥޤ\n"); 

2.	2ĤͤϤȡ1ܤͤ2ܤͤǳä̤ɽ륹ץȤʤơȥȽҤȤä0 ˤ򤷤ʤ

# 2ͤν0ϥơȥȽҤǲ򤹤
#  divide0.pl

print "1ܤοͤϤƤ: ";
$number1 = <STDIN>;
chomp($number1);
print "2ܤοͤϤƤ: ";
$number2 = <STDIN>;
chomp($number2);

# unlessǽ
print ($number1 / $number2) unless ($number2 == 0);
print "\n";

3.	ΥץȤ򡢥ơȥȱ黻ҤȤäûľʤ

# Ĺifʸ
#  long_if.pl

$number1 = 1;
$number2 = 0;
if ($number1 | $number2 == 1) {
  print "OR\n";
}
if ($number1 & $number2 == 1) {
  print "AND\n";
}
if ($number1 ^ $number2 == 1) {
  print "XOR\n";
}


# ơȥȱ黻ҤȤäifʸ
#  statement_if.pl

$number1 = 1;
$number2 = 0;
print "OR\n" if ($number1 | $number2 == 1);
print "AND\n" if ($number1 & $number2 == 1);
print "XOR\n" if ($number1 ^ $number2 == 1);

4.1
1.	Ȥƿ17ȡбơSunסSatפɽ륹ץȤʤ

# Ϥɽ
#  week.pl

# ̾
@week = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');

print "ꤷƤ(17): ";
$number = <STDIN>;
chomp($number);

# ̾ɽ
print ($week[$number - 1], "\n");

ޤΤ褦ʥץȤǽǤ

# Ϥɽ
#  week2.pl

print "ꤷƤ(17): ";
$week = <STDIN>;
chomp($week);

# ̾ɽ
print (('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')
  [$week - 1], "\n");

2.	͡53ʸAZޤǤ˳Ǽơɽ륹ץȤʤ

# ϰϱ黻ҤȤäꥹȤλ
#  region2.pl

# ͤȱѻϰ
@numbers_and_alphabets = (-5 .. 3, "A" .. "Z");
print @numbers_and_alphabets, "\n";

4.2
1.	pushؿpopؿȤäơǤνդˤ̤˥ԡ륹ץȤʤ

# pushpopս˥ԡ
#  array_reverse.pl

# 
@original_array = (1 .. 9);
print ": ", @original_array, "\n";

# ФΤʤʤޤwhileơȥȤ򷫤֤
while (@original_array) {
  # 1ĤļФԡ
  push(@reverse_array, pop(@original_array));
}

# դɽ
print "ս: ", @reverse_array, "\n";

	whileơȥȤξＰ@original_arrayꤷơǤʤʤޤǥ롼פ򷫤֤Ƥޤwhile롼pushؿǤϡ1ˡǤսƤο@reverse_arrayꤷƤޤpush2ɲäǤλǤǤpopؿꤷƤ뤿ᡢδؿǸ@original_arrayФǤ˽ɲäƤŪ˵ս󤬺ޤ

2.	unshiftؿshiftؿȤäơ1.ΥץȤ񤭴ʤ

# shiftunshiftս˥ԡ
#  array_reverse.pl

# 
@original_array = (1 .. 9);
print ": ", @original_array, "\n";

# ФΤʤʤޤwhileơȥȤ򷫤֤
while (@original_array) {
  # 1ĤļФԡ
  unshift(@reverse_array, shift(@original_array));
}

# դɽ
print "ս: ", @reverse_array, "\n";

4.3
1.	Ĵ٤ơ5礭ͤФɽ륹ץȤʤ

# 5礭ɽ
#  larger.pl

@array = (1 .. 10);

foreach $number (@array) {
  if ($number > 5) {
    print "5礭Ǥ: $number\n";
  }
}

2.	ΥץȤ¹ԤȡɤΤ褦ʷ̤ɽޤ

# foreachơȥȤΰΥƥ
#  foreach3.pl

@numbers = (0 .. 3);
foreach $value (@numbers) {
    $value *= 2;
}
print @numbers, "\n";
print @numbers * 2, "\n";


0246
8
	1ܤ@numbersˤϡ0123Ȥ4ĤǤǼޤforeachǤϡǤ1ĤĽ֤$value˳Ǽ뤿ᡢ$value *= 2ˤäƤ줾Ǥͤ2ܤˤʤޤäơforeachơȥȤλȤ@numbersˤ0246ǼƤޤ
	1ܤprintǤ@numbersꥹȤȤư뤿ᡢǤͤĤʤʸɽޤ2ܤprintǤ@numbers顼ѿȤư뤿ᡢǤο42ܤ8ɽޤ

4.4
1.	1100ޤǤοͤɤߡ235ǳڤǤο򤽤줾Ĵ٤ɽ륹ץȤ򡢥ϥåȤäƺʤ

# Τ235ǳڤǤο򤽤줾Ĵ٤
#  divide.pl

@array = ( 1 .. 100 );

# 
foreach $number (@array) {
  if ($number % 2 == 0) {
    # 2ǳڤ
    $total{'2'}++;
  }
  if ($number % 3 == 0) {
    # 3ǳڤ
    $total{'3'}++;
  }
  if ($number % 5 == 0) {
    # 5ǳڤ
    $total{'5'}++;
  }
}

# ̤ɽ
print "2ǳڤǿ: ", $total{'2'}, "\n";
print "3ǳڤǿ: ", $total{'3'}, "\n";
print "5ǳڤǿ: ", $total{'5'}, "\n";

4.5
1.	ꥹ("a","i","u","e","o")γǤ򥭡ꥹ("","","","","")γǤͤȤϥåꡢΥꥹȡͤΥꥹȡڥΰ򤽤줾ɽʤ

# keysvalueseachΥƥ
#  keys_values_each2.pl

# aiueoΥꥹ
@array1 = ("a", "i", "u", "e", "o");

# Υꥹ
@array2 = ("", "", "", "", "");

for ($i = 0; $i < @array1; $i++) {
  # ϥå%array3˳Ǽ
  $array3{$array1[$i]} = $array2[$i];
}

# ꥹɽ
print ":\n\t";
foreach $key (keys(%array3)) {
  print "$key ";
}

# ͥꥹɽ
print "\n:\n\t";
foreach $value (values(%array3)) {
  print "$value ";
}

# ڥɽ
print "\nڥ:\n\t";
print "$key -> $value " while (($key, $value) = 
  each(%array3));
print "\n";

5.1
1.	Ϥ줿ʸ󤫤ʸiIȴФơοɽ륹ץȤʤ

# ʸiפοɽ
#  count.pl

print "ʸϤƤ: ";
$string = <STDIN>;
chomp($string);

# (ʸʸ̤ʤ)
$count++ while ($string =~ /i/gi);

# ɽ
print "Ŀ: $count\n";

	iΥѥޥåiץꤷƤΤǡʸʸζ̵̤뤵ơiIξ˥ޥåޤޤwhilegץʻѤ뤳Ȥǡ֤ԤäƤޤ

5.2
1.	Ϥ줿ʸñ줴Ȥ˶ڤꡢñ: ڤ줿ñפΤ褦ɽ륹ץȤʤ

# ʸ󤫤ñ
#  split.pl

print "ʸϤƤ: ";
$string = <STDIN>;
chomp($string);

# gץwhileơȥȤȤäñȴФ
print "ñ:$&\n" while ($string =~ /\w+/g);

2.	ΥץȤ¹ԤȡɤΤ褦ʷ̤ɽ뤫ʤ

# äˤޥåμ
#  parent.pl

if ("abcdef" =~ /.(((.).)(.).)./) {
  # ޥåͤɽ
  print "1=$1 2=$2 3=$3 4=$4\n";
}


1=bcde 2=bc 3=b 4=d

3.	ΥꥹȤͿ줿ȤdǤϤޤonǽñΤߤɽ륹ץȤʤ

@array = ("nation",
          "solution",
          "distribution",
          "edition",
          "disk",
          "direct connection",
          "destruction",
          "dimension",
          "director",
          "donkey"
         );


# dǤϤޤonǽñɽ
#  foreach_d_on.pl

@array = ("nation",
          "solution",
          "distribution",
          "edition",
          "disk",
          "direct connection",
          "destruction",
          "dimension",
          "director",
          "donkey"
         );

foreach $value (@array) {
  print "$value, " if ($value =~ /^d\w*on$/);
}
print "\n";

4.	Τ褦ʥץȤޤ# פβսˡΥ1ȥ2Ǥϡ¹Է̤ˤɤΤ褦ʰ㤤ޤ

# ĹפȺû
#  longest_shortest.pl

$html = <<EOT;
<HTML>
  <HEAD>
    <TITLE>My Home Page</TITLE>
  </HEAD>
  <BODY>
    <H1>This is my home page</H1>
  </BODY>
</HTML>
EOT

# 

1
while ($html =~ /<.+>/g){
  print "$&\n";
}

2
while ($html =~ /<.+?>/g) {
  print "$&\n";
}


1ɽ<ǻϤޤꡢǤդʸϤ>ǽĹʸ˥ޥåΤФơ2ɽϡ<ǻϤޤꡢǤդʸϤ>ǽûʸ˥ޥåޤäơ12μ¹Է̤ϼΤ褦ˤʤޤ

1
<HTML>
<HEAD>
<TITLE>My Home Page</TITLE>
</HEAD>
<BODY>
<H1>This is my home page</H1>
</BODY>
</HTML>
2
<HTML>
<HEAD>
<TITLE>
</TITLE>
</HEAD>
<BODY>
<H1>
</H1>
</BODY>
</HTML>

5.3
1.	ڡʸǶڤ줿2Ĥʸν֤ؤ륹ץȤʤ

# ڡʸǶڤä2ͤؤ
#  swap.pl

print "2Ĥñ򥹥ڡǶڤäϤƤ: ";
$string = <STDIN>;
chomp($string);

# ؤ
$string =~ s/(\w+)\s+(\w+)/$2 $1/;

# ɽ
print "$string\n";

2.	ڡʸǶڤ줿2Ĥοͤξ륹ץȤs黻ҤȤäƺʤ

ҥ ִμ/ȤȤˤϡ\ʸդƥץ󥹤ˤɬפޤ


# ڡʸǶڤä2ͤξɽ
#  divide.pl

print "2Ĥοͤ򥹥ڡǶڤäϤƤ: ";
$string = <STDIN>;
chomp($string);

# eץȤäľܱ黻
$string =~ s/(\-?\d+\.?\d*)\s+(\-?\d+\.?\d*)/$1 \/ $2/e;

# ɽ
print "$string\n";

6.1
1.	10 ʿοͤϤ4 16 ʿѴɽ륹ץȤprintfؿȤäƺʤɽ16ʿ4ʤȤϡ­ʤʬ0ΤȤޤ

# Ϥ줿10ʿͤ16ʿˤ
#  hex.pl

print "10ʿοͤϤƤ: ";
$number = <STDIN>;
chomp($number);

# 16ʿɽ
printf("16ʿ: %04x\n", $number);

2.	Ϥ줿ʸ1ʸĤʬ䤷Ǵ֤ˡ.פɽ륹ץȤsplitؿjoinؿȤäƺʤ

ҥ splitؿɽˤȡʸ1ʸĶڤ뤳ȤǤޤ


# ʸʬ䤷֤.ɽ
#  period.pl

print "ʸϤƤ: ";
$string = <STDIN>;
chomp($string);

# split1ʸĤʬ䤷joinϢ뤹
print join(".", split(//, $string)), "\n";

3.	ʸդޤˤɽ륹ץȤchopؿȤäƺʤȤPERLȤʸꤹȡLREPɽ褦ˤޤ

ҥ whileơȥȽҤޤuntilơȥȽҤʻѤȤ褤Ǥ礦


# ʸսˤ
#  reverse.pl

print "ʸϤƤ: ";
$string = <STDIN>;
chomp($string);

# $stringˤʤޤФɽ
print chop($string) while ($string);
print "\n";

4.	ʸǤĥꥹȤơǤʸιפɽ륹ץȤʤ

# ꥹȤγǤĹιפ׻
#  list_length.pl

@array = ('Apple', 'Orange', 'Pine', 'Banana');

# 
foreach $value (@array) {
  # ͤ˲û
  $sum += length($value);
}
print ":$sum\n";

6.2
1.	ϡatan2(, sqrt(1- * ))ǵޤ饸ͤϤȥͤɽ륹ץȤʤ

# 
#  arcsin.pl

print "01ϰϤǥ饸ͤ: ";
$radian = <STDIN>;
chomp($radian);

# ׻
print (": ", 
  (atan2($radian, sqrt(1 - $radian * $radian))), "\n");

2.	ˤʤ륹ץȤintؿrandؿȤäƺʤ

ҥ 6̤ꡢ1­ޤ

# 
#  dice.pl

# randintܤ
print ": ", int(rand(6) + 1), "\n";

3.	logexͤloge10ǳȡlog10x뤳ȤǤޤꤷͤlog10륹ץȤʤ

# log10
#  log.pl

print "ͤϤƤ: ";
$number = <STDIN>;
chomp($number);

# log10׻ɽ
print "log10: ", (log($number) / log(10)), "\n";

6.3
1.	ߤ24λ־Ĵ٤륹ץȤʤ뤦äϹͤʤΤȤޤ

# 24λ־ɽ
#  yesterday.pl

# Ǽ(1ʬÿtime)
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday,
  $isdst) = localtime(time - (24 * 60 * 60));

# ɽ
printf("24:\t%s/%s/%s %s %02d:%02d:%02d\n",
  $year + 1900, ++$mon, $mday,
  ("", "", "", "", "", "", "")[$wday],
    $hour, $min, $sec);

2.	ǯϤߤηƱǤǯȽʡΥåɽ륹ץȤʤ

# ηвƳФ
#  birthday.pl

use Time::Local;

$tvalue = time;

# ǯ
print "ǯ (YYYY/MM/DD): ";
$string = <STDIN>;
chomp($string);
($byear, $bmonth, $bday) = split(/\//, $string);

# ߤλ
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime( );

if (($bmonth - 1) == $mon && $bday == $mday) {
  print $year + 1900 - $byear,  "ФΤǤȤޤ\n";
}

6.4
1.	ͤϤȡͤʿɽ륹ץȤʤͤʿ褦Ȥȥ顼ˤʤΤǡevalؿȤäƥ顼ªʤ

# 顼ªդʿ
#  eval_sqrt.pl

print "ͤϤƤ: ";
$number = <STDIN>;
chomp($number);

# evalsqrt¹
eval("print sqrt($number), \"\\n\"");
print "顼ȯޤ: $@" if ($@);

2.	reverseؿϻȤ鷺sortؿȥ饤󥵥֥롼ΤߤȤäϤͤΥꥹȤ礭˥Ȥ륹ץȤʤ

ҥ žȯۤǤ


# ڡʸǶڤäͥꥹȤս󤹤
#  sort_reverse2.pl

print "Ǥ򥹥ڡʸǶڤäͤΥꥹȤϤƤ: ";
$numbers = <STDIN>;
chomp($numbers);

# Ȥɽ
print join(", ", sort { $b <=> $a } (split(/\s+/, 
  $numbers))), "\n";

3.	0255ޤǤ10ʿοͤϤȡοͤ2ʿѴɽ륹ץȤpackؿȤäƺʤ

ҥ packؿȤäƿͤ٥ѥåƤ顢unpackؿȤäŬڤʥեޥåȤǿͤФȡ2ʿ10ʿѴʤɤԤȤǤޤ


# 10ʿ2ʿؤѴ
#  bitcalc.pl

print "0255ޤǤοͤϤƤ: ";
$num = <STDIN>;
chomp($num);

$packed = pack("I", $num);
$bin = unpack("B8", $packed);
print "2ʿ: $bin\n";

4.	Фơ5øɽ륹ץȤʤ

# 5øɽ륯
#  quiz_sleep.pl

$question = "ǰ礭ʸФ?\n";
$answer = ": Գ\n";

print $question;
        sleep(5);
print $answer;


7.1
1.	Ϥcmñ̤˴֤֥롼ʤ

ҥ 12.54cmǤ


# cm˴ɽ
#  inch.pl

print "Ѵ륤ϤƤ: ";
$inch = <STDIN>;
chomp($inch);

print "$inch  = ", &inch_cm($inch), " cm\n";

# cmѴ륵֥롼
sub inch_cm {
  my($inch) = @_;
  $inch * 2.54;
}

2.	ͤϤȤοͤγ֤֥롼򡢺ƵƤӽФȤäƺʤȤϡ123 ... NͤΤȤǤȤ4γ123424ˤʤޤ

# 
#  factorial.pl

print "ϤƤ: ";
$number = <STDIN>;
chomp($number);

# ƤӽФɽ
print "$number! = ", &factorial($number), "\n";

# ֥롼
sub factorial {
  my($number) = @_;

  if ($number <= 1) {
    # 1ʲʤ餽Τޤ
    $answer = $number;
  } else {
    # ƵƤӽФ
    $answer = $number * &factorial($number - 1);
  }
  # ̤ͤˤ
  $answer;
}

ǽfactorial֥롼θƤӽФǤϡޤ͡$numberˤ1ʲɤȽꤷޤơ1ʲΤȤϡñˤͤѿͤȤƥ֥롼ȴ̤ɽޤ!ϳɽصǤʤǤ0οꤵ줿ϹͤʤȤˤޤˡ
ͤ1礭Ȥˤϡ׻Ԥޤη׻Ǥϡfactorial֥롼󼫿ȤƤӽФֺƵƤӽФפԤäƤޤ2ܤfactorialƤӽФǤ⡢ǽθƤӽФƱͤͤ1ʲɤȽꤷޤθƤӽФǤϡ$numberǤϤʤ$number-1Ǥ뤳ȤդƤͤˤäƤfactorial֥롼󤬲٤ƵŪ˸ƤӽФ뤳ȤˤʤޤƤӽФȤ$numberͤ1ĸ餷Ƥ뤿ᡢƤӽФʵפ˷֤ȤϤޤ󡣤Ȥлͤ4ΤȤˤϡ4321׻塢1礭פȤ˹ʤʤꡢ٤Ƥfactorial֥롼ƤӽФȴơ̤ɽޤ

7.2
1.	ΥץȤ¹ԤȽϤͤϤĤǤ

# פĴ٤
#  sum.pl

# 
$sum = 10;

# ֥롼1ƤӽФ
&sum1( );

print ": $sum\n";

# ֥롼1
sub sum1 {
  $sum++;
  {
    local($sum);
    $sum++;
    &sum2( );
  }
  &sum3( );
}

# ֥롼2
sub sum2 {
  $sum++;
}

# ֥롼3
sub sum3 {
  my($sum);
  $sum++;
}


11
localmyѿϡɤ⥵֥롼ȴ̵ˤʤΤǡɡǽ$sum++̣ĤȤˤʤޤ

7.3
1.	ϥåΥե󥹤ꡢͤդˤ֤֥롼Υ֥롼Ѥ륹ץȤʤ

ҥ reverseؿΰ˥ϥåꤹȡͤդˤǤޤ


# ϥåΥե
#  reference_hash.pl

%hash = ("A" => 1,
         "B" => 2,
         "C" => 3,
         "D" => 4);

# ֥롼¹
print "[¹]\n";
print "$key = $value\n" while (($key, $value) = each(%hash));

# ե󥹤Ϥƥ֥롼¹
&sub_reference_hash(\%hash);

# ֥롼¹Ը
print "[¹Ը]\n";
print "$key = $value\n" while (($key, $value) = each(%hash));

# ֥롼
sub sub_reference_hash {
  # ե󥹤
  my($reference_hash) = @_;

  # ե󥹤ΥϥåƤž
  %$reference_hash = reverse (%$reference_hash);
}

2.	ΥץȤΤ֥롼triangleν̵֥̾롼Ȥäƽ񤭴ʤ

# ѷѤĴ٤
#  triangle.pl

$base = 15;
$height = 20;

$area = &triangle($base, $height);
print " $base ⤵ $height λѷѤ $area Ǥ\n";

sub triangle {
  my($base, $height) = @_;
  my($area) = $base * $height / 2;
  return($area);
}


# ѷѤĴ٤ (̵֥̾롼)
#  triangle2.pl

$base = 15;
$height = 20;

$triangle_ref = sub ($base, $height) {
                my($base, $height) = @_;
                my($area) = $base * $height / 2;
                return($area);
              };

$area = &$triangle_ref($base, $height);
print " $base ⤵ $height λѷѤ $area Ǥ\n";

7.4
1.	˻ꤷ2ĤͤξʾʲڤΤơˤ֤֥롼ޤ⥸塼ʤʤ0ǳȤȤˤʸERR֤褦ˤʤ

# 2Ĥοͤξ֤
#  divide.pm

# ֥롼
sub divide {
  my($number1, $number2) = @_;

  # ͤ0ΤȤˤϥ顼֤
  return("ERR") if ($number2 == 0);

  # ʲڤΤƤ֤
  int($number1 / $number2);
}

1;

	Υ⥸塼ϡΤ褦ʥץȤƤӽФޤ

# divide.pmƤӽФ
#  divide_call.pl

# ⥸塼ƤӽФ
use divide;

print "оݤοͤϤƤ: ";
$number1 = <STDIN>;
chomp($number1);
print "ͤϤƤ: ";
$number2 = <STDIN>;
chomp($number2);

print ": ", &divide($number1, $number2), "\n";

2.	ϻȽλ˻֤ɽ⥸塼ʤʤΥ⥸塼ǤϡpackageơȥȤȤätimeȤѥå̾ʤ

# ϻȽλ˻֤ɽ
#  time.pm

# ѥåȤ
package time;

# ֤֤
sub gettime {
  # ֤
  my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday,
    $isdst) = localtime( );
  # ֤
  sprintf("%02d:%02d:%02d", $hour, $min, $sec);
}

# BEGIN롼
BEGIN {
  print ": ", &gettime( ), "\n";
}

# END롼
END {
  print "λ: ", &gettime( ), "\n";
}

1;

	Υ⥸塼ϡΤ褦ʥץȤƤӽФޤ

# time⥸塼ƤӽФ
#  time_call.pl

# ѥåƤӽФ
use time;

print "Enter򲡤Ƥ";
$key = <STDIN>;

	time.pm⥸塼Ǥϡ־ơֻ:ʬ:á׷֤gettime֥롼ƤޤޤBEGIN롼END롼ơ⥸塼γϻȽλgettime֥롼󤬸ƤӽФ褦ˤƤޤ
	time_call.plץȤǤϡuseơȥȤǥѥåƤӽФȤȤˡɽ̤鳫ϤȽλΥߥ󥰤ǧ䤹䤹뤿ˡEnterϥǲԤϤƤޤ

7.5
1.	Cwd⥸塼ȤäơߤΥǥ쥯ȥɽʤ

ҥ Cwd⥸塼cwdؿѤȡߤΥǥ쥯ȥ򼨤ʸ뤳ȤǤޤ

# ߤΥǥ쥯ȥ̾ɽ
#  cwd_call.pl

# ⥸塼ƤӽФ
use Cwd;

# ؿƤӽФɽ
print "ߤΥǥ쥯ȥ: ", getcwd( ), "\n";

8.1
1.	ԡΥե̾ȥԡΥե̾ϤȡեΥԡԤץȤʤ

# եƤ̤Υե̾Υե˥ԡ
#  copy.pl

print "ԡΥե̾ꤷƤ: ";
$from_file = <STDIN>;
print "ԡΥե̾ꤷƤ: ";
$to_file = <STDIN>;

chomp($from_file, $to_file);

# 줾Υե򥪡ץ
open(F, $from_file)   || die "$from_file 򥪡ץǤޤ:$!\n";
open(F2, ">$to_file") || die "$to_file Ǥޤ:$!\n";

while (<F>) {
  # ԡΥե뤫ɤ߹ߡԡΥե˽񤭽Ф
  print F2;
}

close(F2);
close(F);

2.	桼Ϥʸ򡢥եdictionary.txtκǸɲä륹ץȤʤ

# եɲä
#  dictionary_append.pl

print "ɲäʸꤷƤ: ";
$input_str = <STDIN>;

open (F, ">>dictionary.txt") || die "ե뤬ޤǤ:$!\n";
  print F $input_str;
close(F);

3.	ꤷեɤ߼ꡢեPerlȤʸޤޤƤ뤫ɤĴ٤륹ץȤʤ

# ե뤫ʸõ
#  find.pl
print "ե̾ꤷƤ: ";
$file_name = <STDIN>;
chomp($file_name);

open (F, "<$file_name") || die "ե뤬ޤǤ:$!\n";
  while (<F>) {
    if (/Perl/) {
      $match = 1;
      last;
    }
  }
close(F);

print $match ? "$file_nameˤʸPerlפޤޤƤޤ\n" : "$file_nameˤʸPerlפޤޤƤޤǤ\n";

8.2
1.	ܡɤϤ򡢥ENDޤʸޤǡΤޤɸ२顼Ϥɽ륹ץȤʤ

# ɸϤɸ२顼˥쥯Ȥ
#  redirect_stderr.pl

do {
  # ɸϤ
  $string = <STDIN>;
  # ɸ२顼ϤˤΤޤ޽
  print STDERR $string;
  # ENDޤʸ󤬤Ƚλ
} until ($string =~ /END/);

2.	1ܤΰ˻ꤷʸե̾ȸʤơΥեɸϤ񤭹ॹץȤʤʤꤵƤʤȤˤϡɸ२顼Ϥ˥顼åɽƥץȤλʤ

# ɸϤե˽Ϥ
#  std_file.pl

if (@ARGV < 1) {
  # 1ĤꤵƤʤ
  print STDERR "ꤵƤޤ\n";
  exit(1);
}

# 1ܤΰե̾Ȥƺ
open(F, ">$ARGV[0]") || die "$ARGV[0] Ǥޤ:$!\n";
while (<STDIN>) {
  # ɸϤեϥɥ˽
  print F;
}
close(F);

8.3
1.	ꤷե̾ȤưΥեνͭԤ桼ȤǤꡢ˥桼ɤ߹߸¤äƤС¸θ¤˲äƽͭԤȥ롼פν񤭹߸¤դ륹ץȤʤ

ҥ ¸θ¤Ƚ񤭹߸0220¤chmodΰ˻ꤷޤ


# ¸Υե˸¤ɲä
#  append_mod.pl

if (@ARGV > 0) {
  if (-o $ARGV[0]) {
    # ͭԤΥե뤫ɤĴ٤

    # ե
    ($device, $inode, $mode, $nlink, $userid, $groupid, 
     $rdev, $size, $accesstime, $modifytime, $changetime, 
     $blocksize, $blockcount)
      = stat($ARGV[0]);

    # ¤ɲ
    chmod($mode | 0220, $ARGV[0]);
  } else {
    print "ͭΥեǤϤޤ\n";
  }
} else {
  print "ե̾ꤷƤ\n";
}

2.	ե̾ȤƼꡢΥե̵ͭǧ塢<ե̾>ޤ? (Y/N):פȤåФơY줿ȤΤߥե륹ץȤʤYNʳʸϤ줿Ȥϡ⤦١ǧåɽΤȤޤ

# եκ˳ǧ
#  remove_ask.pl

$filename = $ARGV[0];

if (-f $filename) {
  while () {
    print "$filenameޤ? (Y/N): ";
    $answer = <STDIN>;
    chomp($answer);

    if($answer eq 'Y') {
      unlink ($filename) or die "$filenameϺǤޤǤ
        :$!\n";
      last;
    } elsif ($answer eq 'N') {
      last;
    } else {
      print "̵ͤϤޤ\n";
    }
  }
} else {
  print "$filename¸ߤޤ\n";
}

8.4
1.	ߤοƥǥ쥯ȥΥեɽ륹ץȤʤ.פȡ..פϼΤȤޤ

# ƥǥ쥯ȥƤɤ߹ɽ
#  parentdir.pl

# ƥǥ쥯ȥ򥪡ץ󤹤
opendir(DIR, "..") || die ".. 򥪡ץǤޤ:$!\n";

# ɤ߹
@files = readdir(DIR);

# 
closedir(DIR);

# ɽ
foreach (@files) {
  # .  .. ʳɽ
  print "$_\n" unless (/\.{1,2}/);
}

	ǸΥơȥȤunlessʲ...Ƥ뤳ȤդƤ\..򥨥ץ󥹤ˤΡ{1,2}ľʸ1Ĥ뤤2³Ȥ̣Ǥ

8.5
1.	ɸϤϤʸ򥳥ޥɤȤƼ¹Ԥ륹ץȤsystemؿȤäƺʤ

# systemؿˤǤդΥޥɤμ¹
#  shell2.pl

print "¹Ԥ륳ޥ̾ϤƤ: ";
$command = <STDIN>;
chomp($command);

# Υޥɤ¹
system($command);

9.1
1.	PINGϤPONGֻ֤11Υ饤/Сƥʤ
	
С:

# PING/PONGС
#  pingpongserver.pl

# ⥸塼λ
use IO::Socket;

# åȥ֥Ⱥ
$server_socket = new IO::Socket::INET (
                        LocalPort => '10000',
                        Proto => 'tcp',
                        Listen => 5,
                        Reuse => 1 );
unless ($server_socket) {
  print "Socket Error:$!\n";
}

# 饤Ȥ
$client_socket = $server_socket->accept( );
$string = <$client_socket>;
if ($string =~ /PING/) {
  # PONG
  print $client_socket "PONG\n";
}

# åȤĤ
$server_socket->close( );

饤:

# PING/PONG 饤
#  pingpongclient.pl

# ⥸塼λ
use IO::Socket;

# åȥ֥Ⱥ
$client_socket = new IO::Socket::INET (
                        PeerAddr => 'localhost',
                        PeerPort => '10000',
                        Proto => 'tcp',
                        TimeOut => '5' );
unless ($client_socket) {
  print "Socket Error:$!\n";
}

# Ϥ򥵡С
$string = <STDIN>;
print $client_socket $string;

# СνϤɽ
$receive = <$client_socket>;
print $receive;

# åȤĤ
$client_socket->close( );

2.	1.ΥСʣΥ饤Ȥ³褦˲ɤʤ

# PING/PONGС
#  pingpongserver2.pl

# ⥸塼λ
use IO::Socket;

$SIG{CHLD} = sub { wait( ) };

# åȥ֥Ⱥ
$server_socket = new IO::Socket::INET (
                        LocalPort => '10000',
                        Proto => 'tcp',
                        Listen => 5,
                        Reuse => 1 );
unless ($server_socket) {
  print "Socket Error:$!\n";
}

# 饤Ȥ
do {
  $client_socket = $server_socket->accept( );
  if ($pid = fork( )) {
  }
  elsif (defined $pid) {
    $string = <$client_socket>;
    if ($string =~ /PING/) {
      # PONG
      print $client_socket "PONG\n";
    }
    exit;
  } else {
    die "forkǤޤ:$!\n";
  }
} until (0);

# åȤĤ
$server_socket->close( );

3.	ꤷURLWebڡιդϿեweb_record.logURLդ򥿥֤ǶڤäԤɲä륹ץȤʤ

ҥ GETHEADȤȥإåʬФȤǤޤդϡDate: פθ˽񤫤Ƥޤ


# Webڡռץ
#  collect.pl

# ⥸塼λ
use IO::Socket;

# URL
print "URLꤷƤ: ";
$url = <STDIN>;

# URLۥ̾ȥեѥʬ
chomp($url);
if ($url =~ /http:\/\/([^\/]+)(\/.*)/) {
  $host = $1;
  $file = $2;
} else {
  die "URLˤбƤޤ\n";
}

# Ͽե򳫤
open(F, ">>web_record.log");

# åȥ֥Ⱥ
$client_socket = new IO::Socket::INET (
                        PeerAddr => $host,
                        PeerPort => 'http',
                        Proto => 'tcp',
                        TimeOut => '5' );
unless ($client_socket) {
  print "Socket Error:$!\n";
}

# Ϥ򥵡С
print "$host $file" . "\n";
print $client_socket "HEAD $file HTTP/1.0\n\n";
# Ϥɽ(ʣԤ֤äƤΤǡ꽪ޤǥ롼)
while ($receive = <$client_socket>) {
  print $receive;
  # 2ĲʸäƤ뤳ȤΤǡե˽Ϥ˾ä
  chomp($receive); chomp($receive);
  if ($receive =~ /^Date: (.*)/) {
    # դФեɲ
    $date = $1;
    print F "$url\t$date\n";
  }
}

# åȤĤ
$client_socket->close( );
# եϥɥĤ
close(F);

10.1
1.	1HTMLեΤ줾ΥɤΤ褦ʰ̣ĤĴ٤ʤ

ʾά

10.2
1.	OSʣǤ褦2ΥץȤʤ

#!/usr/bin/perl
# 󥱡ȽCGIץॹץ(ʣб)
# 桼ȤäƤOSιפĴ٤
#  questionnaire3.cgi

# ⥸塼ɤ߹
use CGI;
$query = new CGI;

# ץե¸ߤΥå
if (-f "data/statistic3.log") {
  # ¸ߤʤե򥪡ץ󤹤롣Ԥ饨顼ڡɽ
  open(F, "data/statistic3.log") ||
    &error("ե data/statistic3.log 򥪡ץǤޤ ($!) 
           \n");
  while (<F>) {
    # ʸ
    chomp( );
    # ̾OSӤ
    ($name, $os, $use) = split(/\t/);
    # @nametotal̾
    push(@nametotal, $name);
    # ϥå$ostotal˹ͤ
    # ,ǶڤƤΤʬ
    foreach (split(/,/, $os)) {
      $ostotal{$_}++;
    }
    # ϥå$usetotal˹ͤ
    # ,ǶڤƤΤʬ
    foreach (split(/,/, $use)) {
      $usetotal{$_}++;
    }
  }
  close(F);
}

# 󥱡Ȥ
# ̾饿ʸ(եΥǡζڤˤƤ뤿)
$name = $query->param('name');
$name =~ s/\t//g;
# ̾˽ʣʤ
foreach (@nametotal) {
  if ($_ eq $name) {
    # ΤäȤˤϥ顼ڡɽ
    &error("̾ $name ϤǤϿƤޤ\n");
  }
}

# ꥹosäƤOS̾ϥåɲ
foreach ($query->param('os')) {
  $ostotal{$_}++;
}

# ꥹuseäƤӤϥåɲ
foreach ($query->param('use')) {
  $usetotal{$_}++;
}

# ϿɲáԤ饨顼ڡɽ
open(F, ">>data/statistic3.log") ||
  &error("ե data/statistic3.log ˽񤭹ޤ ($!) \n");
# ꥹosuse,Ƕڤäʸˤƽ񤭹
print F $name, "\t", join(",", $query->param('os')), "\t",
  join(",", $query->param('use')), "\n";
close(F);

# ɽ
print $query->header(-charset=>'Shift_JIS'), 
  $query->start_html(-title=>"ߤΥ󥱡ȷ");
print "<h2>OS</h2>\n";
print "<ul>\n";
# ׿ɽ
print "<li><strong>$os</strong>: $count</li>\n"
  while (($os, $count) = each (%ostotal));
print "</ul>\n";

print "<h2></h2>\n";
# ׿ɽ
print "<li><strong>$use</strong>: $count</li>\n"
  while (($use, $count) = each (%usetotal));
print "</ul>\n";

print $query->end_html( );

sub error {
  # 顼ڡɽΥ֥롼
  my($message) = @_;

  print $query->header(-charset=>'Shift_JIS'), 
    $query->start_html(-title=>"顼");
  print "<h1>顼ȯޤ</h1>\n";
  print $message;
  print $query->end_html( );
  # ۾ｪλ
  exit(1);
}

10.3
1.	1ΥץȤɤMozillaȤɤޤǤʤ֥饦ȡۥ̾.jpʳǽäƤۥȤΥåץɤػߤʤ

#!/usr/bin/perl
# դեɽCGIץॹץ
#  fileinfo2.cgi

# ⥸塼ɤ߹
use CGI;
$query = new CGI;
$filename = $query->param('filename');

# 
if ($query->user_agent( ) !~ /Mozilla/ || 
  $query->remote_host( ) !~ /\.jp$/) {
  &deny( );
}

# ɽ
print $query->header(-charset=>'Shift_JIS'), 
  $query->start_html(-title=>"ե");

print "<h2>ե</h2>\n";
print "<ul>\n";
# 顼ѿȤưȥե֤̾
print "<li>ե̾:", $filename, "</li>\n";
print "<li>եMIME:",
  $query->uploadInfo($filename)->{'Content-Type'} , "</li>\n";
print "</ul>\n";

print "<h2>ե</h2>\n";
print "<PRE>\n";
while (<$filename>) {
  # եƤɽ
  print;
}
print "</PRE>\n";
print $query->end_html( );

sub deny {
  # 
  print $query->header(-charset=>'Shift_JIS'), 
    $query->start_html(-title=>"");

  # ݥåɽ
  print "<p>",
  "ʤΥۥȤ뤤ϥ֥饦Υϵݤޤ",
  "</p>\n";
  print $query->end_html( );

  # ۾ｪλ
  exit(0);
}

11.1
1.	CPUꡢϡɥǥʤɤΡɤȤƤʤΥԥ塼ιXMLɽʤ

ʾά

2.	ʤȤäƤ륷ƥǤϤɤΤ褦ʸѤǤ뤫Ĵ٤ʤ

ʾά

11.2
1.	ǺXMLѡץȤȤäơ11.1ǺXMLɥȤϤʤ

2.	XMLʸäɤparseؿĴ١˹פƤСXMLɥȤǤפȥ֥饦֤Web CGI󥿡եʤ˹פƤʤȤϡXMLɥȤǤפȤʸȡ顼åξ֤ʤ

ҥ ĹƥȤCGIǼդ뤿ˡHTMLΥեȤ<textarea>ǤȤȤ褤Ǥ礦<textarea name="xml" cols=60 rows=30></textarea>Τ褦˵Ҥޤ


HTMLեϼΤ褦ˤʤޤ

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
<!--
 XMLɥȥեդHTML

 xmlinfo.html
-->
<html>
  <head>
    <title>XMLɥȥѡ</title>
  </head>

  <body>
    <h1>XMLɥȥѡ</h1>

    <p>ϤXMLɥȤơϤ򲡤Ƥ</p>

    <form action="/cgi-bin/xmlinfo.cgi" method="post" 
        enctype="multipart/form-data">
      <p><textarea name="xml" cols=60 rows=20></textarea></p>
      <p>
        <input type="submit" name="send" value=""><br>
        <input type="reset" value="ꥻå">
      </p>
    </form>

  </body>
</html>

CGIץϼΤ褦ˤʤޤ

#!/usr/bin/perl
# XMLѡCGIץॹץ
#  xmlinfo.cgi

# ⥸塼ɤ߹
use CGI;
use XML::Parser;

$query = new CGI;
$content = $query->param('xml');

# ɽ
print $query->header(-charset=>'Shift_JIS'), 
  $query->start_html(-title=>"XML Parser");

$parser = new XML::Parser( ErrorContext=>3 );
eval ( "\$parser->parse( \$content );" );

if ($@) {
  chomp($@);
  $@ =~ s/^\n//;
  $@ =~ s/ at (?:[A-Z]:)?\/.*//;
  $@ =~ s/\&/\&amp;/g;
  $@ =~ s/</\&lt;/g;
  $@ =~ s/>/\&gt;/g;

  print "<p>XMLɥȤǤ</p>\n";
  print "<PRE>\n";
  # 顼åɽ
  print $@;
  print "</PRE>\n";
} else {
  print "<p>XMLɥȤǤ</p>\n";
}
print $query->end_html( );

11.3
1.	XMLɥȤ顢nameaddresstelǤͤȴФ̾,,ֹפηCSVˤǽϤԤץȤʤ

<?xml version="1.0" encoding="utf-8"?>
<addressbook>
  <title>Ͽ</title>
  <info>
    <name></name>
    <address>ë</address>
    <tel>03-XXXX-XXXX</tel>
  </info>
  <info>
    <name></name>
    <address></address>
    <tel>06-XXXX-XXXX</tel>
  </info>
  <info>
    <name>ƣ</name>
    <address>ܾ븩</address>
    <tel>022-XXX-XXXX</tel>
  </info>
</addressbook>


# ϿCSV
#  addressbook.pl
use encoding "utf8", STDOUT=>"Shift_JIS";
use XML::Parser;

# ϥɥդǥ֥Ȥ
$parser = new XML::Parser( Handlers => 
				   {Start=>\&element_start,
				    Char => \&cdata,
				    End => \&element_end});

# ̾¸ѿ
$element_name = '';
# Ͽ
%records = {};

# Ϥμ¹
eval ( "\$parser->parsefile( \@ARGV[0] );");

if ($@) {
  chomp($@);
  $@ =~ s/^\n//;
  $@ =~ s/ at (?:[A-Z]:)?\/.*//;
  print @ARGV[0] . "XMLɥȤǤ (顼: $@)\n";
}

sub element_start {
  # Ǥγ
  my ($expat, $name, %attributes) = @_;
  $element_name = $name;
  # ϥå
  $records = {} if ( $name eq 'info' );
}

sub element_end {
  # Ǥνλ
  my ($expat, $name) = @_;
  if ( $name eq 'info' ) {
    # ϥå
    print $records{'name'} . "," . $records{'address'} . "," 
      . $records{'tel'} . "\n";
  }
  $element_name = '';
}

sub cdata {
  # ƥȥǡ
  my ($expat, $context) = @_;
  # ϥå˳Ǽ
  $records{$element_name} = $context if ($element_name);
}

¹Է̤ϼΤ褦ˤʤޤ

,ë,03-XXXX-XXXX
,,06-XXXX-XXXX
ƣ,ܾ븩,022-XXX-XXXX

11.4
1.	11.4 1.XPathץȤȤäơʥѥɽƤߤʤ

ʾά
