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

1.1FK
1.	ʂ-0.123ƕ\XNvg𒼐ڃR}hCɋLqĎsȂB܂AXNvgt@C쐬ĎsȂB
yz
R}hC:
perl -e 'print -0.123;'

XNvg:
print -0.123;

2.	̃XNvgt@C͐삵܂B

print 1
23;

yz
G[ɂȂ܂B1231̃IvVlƌȂ܂AIvV̒l̓rŃXy[XĂ͂܂B

3.	̃XNvgt@C͐삵܂B

print 123,45,
678;

yz
삵܂Bu,ṽ͕IvV؂邽߂ɎgLł̂ŁA123A45A678Ƃ3̒lw肵̂ƌȂ܂Bu,v̑Oɂ̓Xy[X邱Ƃł܂B

1.2FK
1.	ϐ$nameɂȂ̖OA\ŉsXNvgȂB
yz
$name = "Yamada Taro";
print "$name\n";

2.	̃XNvgsƂǂ̂悤Ȍʂ܂B

$hex = "\x2a";
$abc = "ABC";
$quote = '\n';
print "$hex$quote$abc\n";
yz
*\nABCƕ\܂B$quote̒l'\n'͒Ppň͂܂Ă邽߁Â܂܂̕ƂĈ܂B̒l͂̂Ƃɓdpň͂܂Ăς邱Ƃ͂܂B

3.	̃XNvguHello, Tarokun.vƕ\悤ɏCȂB

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

yz
̂悤ɏC܂B

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

u,v͕ϐɂ͎gȂȂ̂ŁA$hello{ }ň͂ޕKv͂܂B

4.	̃XNvgqqgďȂB

print "dp \"\"  \\\"\\\" Ŏ܂B\"ɂ\"\n";

yz
̂悤ɂ܂B

print qq/dp ""  \\"\\" Ŏ܂B"ɂ"\n/;

1.3FK
1.	܂ŏЉXNvgɃRgtȂB
yz
iȗj

2.	̃XNvgsƂǂ̂悤ȌʂɂȂ܂B

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

yz
삵A1256ƕ\܂B

1.4FK
1.	[U[ɐƖʁXɓ͂Auɂ́A[U[BvƈAԂXNvgȂBAƖ̊Ԃɂ̓Xy[XȂƂƂ܂B
yz	# Ɩ͂āAAԂXNvg
#  hello2.pl

# 
print "Ȃ͉̐ł: ";
# [U[̓͂҂
$surname = <STDIN>;
# s
chomp($surname);

# 
print "Ȃ̖͉ł: ";
# [U[̓͂҂
$firstname = <STDIN>;
# s
chomp($firstname);

# A\
print "ɂ́A$surname$firstname B\n";

2.	u񂲁vpŉƌĂԂiapplejƂāA[U[̓͂ǂɂĈقȂ郁bZ[W\XNvgȂB
yz	# 񂲂̉pꖼ̃NCYXNvg
#  quiz2.pl

print "u񂲁v͉pŉƌĂт܂: ";
# [U[̓͂҂
$answer = <STDIN>;
# s
chomp($answer);

# 𕪊
if ($answer eq "apple") {
  # eq͕񂪓ƂӖ
  # "apple"ɓƂ
  print "ł!\n";
} else {
  # "apple"ɓȂƂ
  print "˂A͂łB\n";
}

2.1FK
1.	̃XNvgsƂǂ̂悤Ȍʂ\܂B

# ܂񂾐l
#  mix_number.pl

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

yz
251
܂u20a1v͐l20ƔF܂B5Z25ƂȂAu.vZq1ƂĘAĂ܂B

2.	*Ƃǂ100\XNvgȂB
yz
# *100\
# asterisk.pl

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

3.	̎̌vZʂ\XNvgȂB

 1

 2     ~  10~2
    
3 + 1     |2|10

yz
# ̎s
#  equation.pl

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

4.	̃XNvgsƂǂ̂悤Ȍʂ\܂B

# Dx
#  minus.pl

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

yz
-2 ** 4 = -16
ݏ͒P}CiXD悳܂B̂߁A-24ł͂Ȃ24sAlɑ΂ĒP}CiXs܂B

2.2FK
1.	̃XNvg̉ZAZCNgZqfNgZqŒuȂB

# CNgZqgpĂȂXNvg
#  replace_original.pl

$number1 = 0;
$number2 = 0;

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

# \
print "CNg:\tl1: $number1 l2: $number2\n";

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

# \
print "fNg:\tl1: $number1 l2: $number2\n";

yz
# CNg/fNgZqŒuXNvg
#  replace_increment.pl

$number1 = 0;
$number2 = 0;

$number2 = ++$number1;

# \
print "CNg:\tl1: $number1 l2: $number2\n";

$number2 = $number1--;

# \
print "fNg:\tl1: $number1 l2: $number2\n";

2.	̃XNvgsƁAǂ̂悤Ȍʂ\܂B

# CNgZq̃eXg
#  increment.pl

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

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

yz
N1:3, N2:1, N3:3
$number1́A2sڂŒl$number2ɑƂŃCNg2ɂȂ܂B3sڂł́A$number1CNg3ɂȂƁA$number3ɒl܂B

2.3FK
1.	210Ƃ2̒lɑ΂āA<ZqsƂltZqsƂ̈Ⴂ𒲂ׂXNvgȂB
yz
# <ZqltZq̈Ⴂ
#  smaller_and_lt.pl

# <Zq
print "<Zqɂ]\n";
if (2 < 10) {
  print "210傫\n";
} else {
  print "102傫\n";
}

# ltZq
print "ltZqɂ]\n";
if (2 lt 10) {
  print "210傫\n";
} else {
  print "102傫\n";
}

̃XNvg̎sʂ͎̂ƂłB

<Zqɂ]
210傫
ltZqɂ]
102傫

<Zq͐l̑召AltZq͕R[h̑召Ƃɕ]s܂BltZqɂ]u102傫vƂȂ̂́Aŏ̃}b`OŁu2vƁu1vrA2̕R[h傫AƔf邽߂łB

2.	͂ꂽɁu؁vƂPꂪĂȂƂmFXNvgȂB
yz
# ےp^[}b`
#  antipattern.pl

print "Ȃ̖O͉ł: ";
$string = <STDIN>;
chomp($string);

# Ɂu؁v܂܂ĂȂƂ𒲂ׂ
if ($string !~ //) {
  print "ɂ́B\n";
} else {
  print "؂̓ANZXł܂B\n";
}

2.4FK
1.	2̒l͂ƁA̘_a\XNvgAZqgčȂB
yz	# 2l̘_a
#  logical_or.pl

print "1ڂ̐l͂Ă: ";
$number1 = <STDIN>;
chomp($number1);
print "2ڂ̐l͂Ă: ";
$number2 = <STDIN>;
chomp($number2);

# 𐔒lɂ
$number1 += 0;
$number2 += 0;

# _a
$number1 |= $number2;

print "_a: $number1\n"

2.	[U[ƃpX[h̓͂vA[U[SECRETUSERApX[hSECRETƍv΁uF؂܂vAǂ炩vȂuۂ܂vƕ\XNvgȂB
yz
# [U[ƃpX[h̔F
#  login.pl

print "[U[͂Ă: ";
$username = <STDIN>;
chomp($username);
print "pX[h͂Ă: ";
$password = <STDIN>;
chomp($password);

# 
if ($username eq "SECRETUSER" && $password eq "SECRET") {
  print "F؂܂B\n";
} else {
  print "ۂ܂B\n";
}

3.	2̒l̓͂󂯎A̒l5傫A1ڂ̒l2ڂ̒l傫΁u^łBvAłȂ΁uUłBvƕ\XNvgȂB
yz
# Z_Zq2l3̘_Ŕr
#  multiple_shortcut.pl

print "1ڂ̐l͂Ă: ";
$number1 = <STDIN>;
chomp($number1);
print "2ڂ̐l͂Ă: ";
$number2 = <STDIN>;
chomp($number2);

# r
if ($number1 > 5 && $number2 > 5 && $number1 > $number2) {
  print "^łB\n";
} else {
  print "UłB\n";
}

2.5FK
1.	qAZqgƁAu'vu"v\̂ɃGXP[vV[PXgKvȂƂm߂ȂB
yz
# '"qAZqŎg
#  here5.pl

print <<EOT
  Pp '
  dp "
EOT
  ;

̃XNvg̎sʂ͎̂悤ɂȂ܂iGXP[vV[PXw肵ȂĂA\邱ƂmFł܂jB

  Pp '
  dp "

2.	qAZqŕ󂯎A5JԂĕ\XNvgȂB
yz
# qAZq̕JԂ
#  here6.pl

$name = "؂";

print <<"EOT"
ɂ́A$nameB
΂́A$nameB
EOT
x 5;

3.1FK
1.	2̒lƋLi+A-A*A/j͂ƁA̒lw肵LŌvZXNvgȂB
yz
# vZ@XNvg
#  calc.pl

print "l1: ";
$value1 = <STDIN>;
print "l2: ";
$value2 = <STDIN>;
print "vZe(+,-,*,/): ";
$calc = <STDIN>;
chomp($value1, $value2, $calc);

if ($calc eq "+") {
  # Z
  $return = $value1 + $value2;
} elsif ($calc eq "-") {
  # Z
  $return = $value1 - $value2;
} elsif ($calc eq "*") {
  # Z
  $return = $value1 * $value2;
} elsif ($calc eq "/") {
  # Z
  unless ($value2 == 0) {
    $return = $value1 / $value2;
  } else {
    # 0 ɂ鏜Z
    $return = "0 ŏZ悤Ƃ܂B";
  }
} else {
  # ǂłȂƂ
  $return = "ȌvZełB";
}

# ʕ\
print "vZ: $return\n";

2.	̃pX[hF؃XNvgAunlessXe[ggŏȂB

# pX[hF؃XNvg
#  password.pl

print "pX[h: ";
$password = <STDIN>;
chomp($password);

if ($password eq "SECRET") {
  print "F؂ɐ܂B\n";
} else {
  print "F؂Ɏs܂B\n";
}

yz
# pX[hF؃XNvg
#  password_unless.pl

print "pX[h: ";
$password = <STDIN>;
chomp($password);

unless ($password ne "SECRET") {
  print "F؂ɐ܂B\n";
} else {
  print "F؂Ɏs܂B\n";
}

3.	̃XNvgsƁAǂ̂悤Ȍʂ\܂B

# unless̓
#  unless.pl

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

yz
AND
	ifɔׂĂ₱܂Aunlesš͎ʂÛƂɎsƂƂoĂΗł͂łB

3.2FK
1.	̃XNvgs2͂ƁAǂ̂悤Ȍʂ\܂B

# {XvZ
#  double.pl

print "l͂Ă: ";
$number = <STDIN>;
chomp($number);

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

yz
l: 2
l: 4
l: 8
l: 16	

2.	uSECRETvƓ͂܂ŁAupX[h͂Ă:vƌJԂ\āA[U[ɓ͂vXNvg쐬ȂB
yz
# pX[h̖₢킹
#  secret.pl

do {
  print "pX[h͂Ă: ";
  $password = <STDIN>;
  chomp($password);
} until ($password eq "SECRET");

	do-whilegċLq邱Ƃł܂B

3.	do-untilXe[gggāAw肵10i2iɕϊXNvgȂB2iƂ́A01ŕ\l̂ƂłBƂ2íu10v10íu2vӖA2íu1011v10íu11vӖ܂B

qg l2ŊƂ̗]̒li[ĂAl2ŊƂ̏ĂуeXg܂B1菬Ȃ܂ŌJԂ܂B

yz
# 10i2iϊ
#  bit.pl

print "10i̐lw肵Ă: ";
$number = <STDIN>;
chomp($number);

$bin = '';

do {
  # 2Ŋ]
  $bin = ($number % 2) . $bin;
  # $number2Ŋ
  $number /= 2;
  # $number1菬Ȃ܂ŌJԂ
} until ($number < 1);

print "2i: $bin\n";

3.3FK
1.	̃XNvgforXe[gggďȂB

# fNg
#  decrement_until.pl

print "l͂Ă: ";
$number = <STDIN>;
chomp($number);

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

yz
# fNg
#  decrement_for.pl

print "l͂Ă: ";
$number = <STDIN>;
chomp($number);

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

2.	w肵l܂ł̐JEgXNvgȂBA413͕\Ȃ悤ɂȂB
yz
# w肵܂ŕ\A413͔΂
#  for_skip4_13.pl

print "l͂Ă: ";
$max = <STDIN>;
chomp($max);

for ($number = 1; $number <= $max; $number++) {
  if ($number == 4 || $number == 13) {
    # $number413̂Ƃɂ1CNg
    $number++;
  }
  print "l: $number\n";
}

3.	1琔l2{ĂA64ɂȂ܂ŕ\XNvgȂB
yz
# 164܂Ŕ{\
#  for_double.pl

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

3.4FK
1.	w肵l܂ł̐JEgXNvgȂBAnextXe[gggāA413͕\Ȃ悤ɂȂB
yz
# w肵܂ŕ\Anextg413͔΂
#  next_skip4_13.pl

print "l͂Ă: ";
$max = <STDIN>;
chomp($max);

for ($number = 1; $number <= $max; $number++) {
  if ($number == 4 || $number == 13) {
    # $number413̂Ƃɂnexts
    next;
  }
  print "l: $number\n";
}

2.	̃XNvgsƁAǂ̂悤Ȍʂ\܂B

# xg[v
#  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";
}

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

3.5FK
1.	͂ꂽSECRETƓ΁uF؂ɐ܂BvAȊOł΁uF؂Ɏs܂Bvƕ\pX[hF؃XNvgA?ZqgčȂB
yz
# ?ZqɂpX[hF؃XNvg
#  password.pl

print "pX[h: ";
$password = <STDIN>;
chomp($password);

print (($password eq  "SECRET") ?
  "F؂ɐ܂B\n" : "F؂Ɏs܂B\n"); 

2.	2̒l͂ƁA1ڂ̒l2ڂ̒lŊʂ\XNvgȂBAXe[ggCqg0 ɂ鏜ZȂB
yz
# 2l̏ZA0Z̓Xe[ggCqŉ
#  divide0.pl

print "1ڂ̐l͂Ă: ";
$number1 = <STDIN>;
chomp($number1);
print "2ڂ̐l͂Ă: ";
$number2 = <STDIN>;
chomp($number2);

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

3.	̃XNvgAXe[ggZqgĒZȂB

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

yz
# Xe[ggZqgif
#  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.1FK
1.	jƂĐl1`7ƁAɑΉāuSunv`uSatv\XNvgȂB
yz
# ͂ɑj̕\
#  week.pl

# T̖O̔zݒ
@week = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');

print "jw肵Ă(1`7): ";
$number = <STDIN>;
chomp($number);

# j̖O\
print ($week[$number - 1], "\n");

܂Â悤ȃXNvg\łB

# ͂ɑj̕\
#  week2.pl

print "jw肵Ă(1`7): ";
$week = <STDIN>;
chomp($week);

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

2.	l|53AAZ܂łzɊi[āA\XNvgȂB
yz
# ͈͉ZqgXg̎w
#  region2.pl

# lƉp͈̔
@numbers_and_alphabets = (-5 .. 3, "A" .. "Z");
print @numbers_and_alphabets, "\n";

4.2FK
1.	push֐pop֐gāAz̗vf̏tɂĕʂ̔zɃRs[XNvgȂB
yz
# pushpopŔztɃRs[
#  array_reverse.pl

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

# ôȂȂ܂whileXe[ggJԂ
while (@original_array) {
  # 1oARs[
  push(@reverse_array, pop(@original_array));
}

# t̔z\
print "tz: ", @reverse_array, "\n";

	whileXe[gg̏ɔz@original_arrayw肵āAz̗vfȂȂ܂Ń[vJԂĂ܂Bwhile[vpush֐ł́A1ɁAvftɓĂ߂̐VȔz@reverse_arrayw肵Ă܂Bpush̑2͔zɒǉvf̎włAłpop֐w肵Ă邽߁Å֐Ō̔z@original_array̖ovfVȔz̖ɏɒǉĂAʓIɋt̔z񂪍܂B

2.	unshift֐shift֐gāA1.̃XNvgȂB
yz
# shiftunshiftŔztɃRs[
#  array_reverse.pl

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

# ôȂȂ܂whileXe[ggJԂ
while (@original_array) {
  # 1oARs[
  unshift(@reverse_array, shift(@original_array));
}

# t̔z\
print "tz: ", @reverse_array, "\n";

4.3FK
1.	鐔lz̒𒲂ׂāA5傫l΂\XNvgȂB
yz
# z̒5傫Ε\
#  larger.pl

@array = (1 .. 10);

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

2.	̃XNvgsƁAǂ̂悤Ȍʂ\܂B

# foreachXe[ggƔz̈̃eXg
#  foreach3.pl

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

yz
0246
8
	1sڂ@numbersɂ́A0A1A2A3Ƃ4̗vfi[܂Bforeachł́A̗vf1Ԃ$valueɊi[邽߁A$value *= 2ɂĂꂼ̗vf̒l2{ɂȂ܂BāAforeachXe[ggIƂA@numbersɂ͗vf0A2A4A6i[Ă܂B
	1ڂprintł@numbersXgƂĈ邽߁Aevf̒lȂ񂪕\܂B2ڂprintł@numbersXJ[ϐƂĈ邽߁Avf̐42{8\܂B

4.4FK
1.	1`100܂ł̐l̔zǂ݁A2A3A5Ŋ؂vf̐ꂼ꒲ׂĕ\XNvgAnbVgčȂB
yz
# ẑA2A3A5Ŋ؂vf̐ꂼ꒲ׂ
#  divide.pl

@array = ( 1 .. 100 );

# z
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Ŋ؂vf: ", $total{'2'}, "\n";
print "3Ŋ؂vf: ", $total{'3'}, "\n";
print "5Ŋ؂vf: ", $total{'5'}, "\n";

4.5FK
1.	Xg("a","i","u","e","o")̊evfL[AXg("","","","","")̊evflƂnbVAL[̃XgAl̃XgAyÄꗗꂼ\ȂB
yz
# keysAvaluesAeach̃eXg
#  keys_values_each2.pl

# aAiAuAeAõXg
@array1 = ("a", "i", "u", "e", "o");

# AAAÃXg
@array2 = ("", "", "", "", "");

for ($i = 0; $i < @array1; $i++) {
  # nbV%array3Ɋi[
  $array3{$array1[$i]} = $array2[$i];
}

# L[Xg\
print "L[:\n\t";
foreach $key (keys(%array3)) {
  print "$key ";
}

# lXg\
print "\nl:\n\t";
foreach $value (values(%array3)) {
  print "$value ";
}

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

5.1FK
1.	͂ꂽ񂩂當iI𔲂oāA̐\XNvgȂB
yz
# uiv̐\
#  count.pl

print "͂Ă: ";
$string = <STDIN>;
chomp($string);

# JEg(啶ʂȂ)
$count++ while ($string =~ /i/gi);

# \
print ": $count\n";

	ĩp^[}b`iIvVw肵Ă̂ŁA啶̋ʂāAiI̗Ƀ}b`܂B܂AwhilegIvV𕹗p邱ƂŁAJԂsĂ܂B

5.2FK
1.	͂ꂽpPꂲƂɋ؂AuP: ؂ꂽPv̂悤ɕ\XNvgȂB
yz
# 񂩂P𒊏o
#  split.pl

print "͂Ă: ";
$string = <STDIN>;
chomp($string);

# gIvVwhileXe[gggĒP𔲂o
print "P:$&\n" while ($string =~ /\w+/g);

2.	̃XNvgsƁAǂ̂悤Ȍʂ\邩ȂB

# ɂ}b`̎擾
#  parent.pl

if ("abcdef" =~ /.(((.).)(.).)./) {
  # }b`l̕\
  print "1=$1 2=$2 3=$3 4=$4\n";
}

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

3.	̃Xg^ꂽƂAdł͂܂onŏIP݂̂\XNvgȂB

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

yz
# dł͂܂onŏIP\
#  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.	̂悤ȃXNvg܂Bu# ɑ}v̉ӏɁAL̃P[X1}ꍇƃP[X2}ꍇł́Asʂɂǂ̂悤ȈႢ܂B

# ŒvƍŒZv
#  longest_shortest.pl

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

# ɑ}

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

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

yz
P[X1̐K\A<Ŏn܂ACӂ͂̕>ŏIŒ̕Ƀ}b`̂ɑ΂āAP[X2̐K\́A<Ŏn܂ACӂ͂̕>ŏIŒZ̕Ƀ}b`܂BāAP[X1AP[X2̎sʂ͎̂悤ɂȂ܂B

P[X1
<HTML>
<HEAD>
<TITLE>My Home Page</TITLE>
</HEAD>
<BODY>
<H1>This is my home page</H1>
</BODY>
</HTML>
P[X2
<HTML>
<HEAD>
<TITLE>
</TITLE>
</HEAD>
<BODY>
<H1>
</H1>
</BODY>
</HTML>

5.3FK
1.	Xy[Xŋ؂ꂽ2͕̓̏ԂւXNvgȂB
yz
# Xy[Xŋ؂2lւ
#  swap.pl

print "2̒PXy[Xŋ؂ē͂Ă: ";
$string = <STDIN>;
chomp($string);

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

# \
print "$string\n";

2.	Xy[Xŋ؂ꂽ2̐l̏߂XNvgAsZqgčȂB

qg u̎̒/gƂɂ́A\tăGXP[vV[PXɂKv܂B

yz
# Xy[Xŋ؂2l̏\
#  divide.pl

print "2̐lXy[Xŋ؂ē͂Ă: ";
$string = <STDIN>;
chomp($string);

# eIvVgĒډZ
$string =~ s/(\-?\d+\.?\d*)\s+(\-?\d+\.?\d*)/$1 \/ $2/e;

# \
print "$string\n";

6.1FK
1.	10 i̐l͂4 16 iɕϊĕ\XNvgAprintf֐gčȂBA\16i4ɖȂƂ́AȂ0𖄂߂̂Ƃ܂B
yz
# ͂ꂽ10i̒l16iɂ
#  hex.pl

print "10i̐l͂Ă: ";
$number = <STDIN>;
chomp($number);

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

2.	͂ꂽ1ɕAevfԂɁu.vĕ\XNvgAsplit֐join֐gčȂB

qg split֐̐K\ɂƁA1؂邱Ƃł܂B

yz
# ͕𕪊AԂ.ĕ\
#  period.pl

print "͂Ă: ";
$string = <STDIN>;
chomp($string);

# split1ɕAjoinŘA
print join(".", split(//, $string)), "\n";

3.	t܂ɂĕ\XNvgchop֐gčȂBƂPERLƂw肷ƁALREP\悤ɂ܂B

qg whileXe[ggCq܂untilXe[ggCq𕹗pƂ悢ł傤B

yz
# tɂ
#  reverse.pl

print "͂Ă: ";
$string = <STDIN>;
chomp($string);

# $stringɂȂ܂ŖoA\
print chop($string) while ($string);
print "\n";

4.	vfXg`āAevf̍̕v\XNvgȂB
yz
# Xg̊evf̒̍vvZ
#  list_length.pl

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

# z
foreach $value (@array) {
  # vlɉZ
  $sum += length($value);
}
print "v:$sum\n";

6.2FK
1.	A[NTĆAatan2(, sqrt(1- * ))ŋ߂܂BWAl͂ƃA[NTCl\XNvgȂB
yz
# A[NTC߂
#  arcsin.pl

print "0`1͈̔͂ŃWAl: ";
$radian = <STDIN>;
chomp($radian);

# A[NTCvZ
print ("A[NTC: ", 
  (atan2($radian, sqrt(1 - $radian * $radian))), "\n");

2.	TCȒɂȂXNvgAint֐rand֐gčȂB

qg 6̗A1𑫂܂B
yz
# TCR
#  dice.pl

# randintŖڂ
print "_CX[: ", int(rand(6) + 1), "\n";

3.	logex̒lloge10ŊƁAlog10x߂邱Ƃł܂Bw肵llog10߂XNvgȂB
yz
# log10߂
#  log.pl

print "l͂Ă: ";
$number = <STDIN>;
chomp($number);

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

6.3FK
1.	݂24ԑO̎ԏ𒲂ׂXNvgȂBA邤b͍lȂ̂Ƃ܂B
yz
# 24ԑO̎ԏ擾A\
#  yesterday.pl

# nŎ擾(1ɑbtime)
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday,
  $isdst) = localtime(time - (24 * 60 * 60));

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

2.	N͂Ǎ݂ƓłΔNƏj̃bZ[W\XNvgȂB
yz
# ǎoߓ𓱏o
#  birthday.pl

use Time::Local;

$tvalue = time;

# aN擾
print "aN (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,  "΂̂a߂łƂ܂B\n";
}

6.4FK
1.	l͂ƁA̒l̕\XNvg쐬ȂBA̒l̕߂悤ƂƃG[ɂȂ̂ŁAeval֐găG[ߑȂB
yz
# G[ߑt̕
#  eval_sqrt.pl

print "l͂Ă: ";
$number = <STDIN>;
chomp($number);

# evalsqrts
eval("print sqrt($number), \"\\n\"");
print "G[܂B: $@" if ($@);

2.	reverse֐͎g킸Asort֐ƃCCTu[`݂̂gē͂l̃Xg傫Ƀ\[gXNvgȂB

qg t]̔złB

yz
# Xy[Xŋ؂lXgtɐ񂷂
#  sort_reverse2.pl

print "vfXy[Xŋ؂l̃Xg͂Ă: ";
$numbers = <STDIN>;
chomp($numbers);

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

3.	0255܂ł10i̐l͂ƁA̐l2iɕϊĕ\XNvgApack֐gčȂB

qg pack֐gĐlxpbNĂAunpack֐gēK؂ȃtH[}bgŐloƁA2iA10i̕ϊȂǂsƂł܂B

yz
# 10i2iւ̕ϊ
#  bitcalc.pl

print "0255܂ł̐l͂Ă: ";
$num = <STDIN>;
chomp($num);

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

4.	NCYoāA5bɓ\XNvgȂB
yz
# 5bɓ\NCY
#  quiz_sleep.pl

$question = "Eňԑ傫Ȍ΂?\n";
$answer = ": JXsC\n";

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


7.1FK
1.	C`͂cmPʂɊZĕԂTu[`쐬ȂB

qg 1C`2.54cmłB

yz
# C`cmɊZĕ\
#  inch.pl

print "ϊC`͂Ă: ";
$inch = <STDIN>;
chomp($inch);

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

# C`cmɕϊTu[`
sub inch_cm {
  my($inch) = @_;
  $inch * 2.54;
}

2.	l͂Ƃ̐l̊KԂTu[`AċAĂяogč쐬ȂBKƂ́A1~2~3 ... ~N̒l̂ƂłBƂ4̊K1~2~3~424ɂȂ܂B
yz
# K߂
#  factorial.pl

print "K搔͂Ă: ";
$number = <STDIN>;
chomp($number);

# Ăяoƕ\
print "$number! = ", &factorial($number), "\n";

# Tu[`{
sub factorial {
  my($number) = @_;

  if ($number <= 1) {
    # 1ȉȂ炻̂܂
    $answer = $number;
  } else {
    # ċAĂяo
    $answer = $number * &factorial($number - 1);
  }
  # ʂ߂lɂ
  $answer;
}

ŏfactorialTu[`̌Ăяoł́A܂Awli$numberj1ȉǂ𔻒肵܂BāA1ȉ̂Ƃ́APɂ̒lϐ߂lƂăTu[`𔲂Aʂ\܂i!͊K\wLłBȂAł0╉̐w肳ꂽꍇ͍lȂƂɂ܂jB
wl1傫Ƃɂ́AvZs܂B̌vZ̒ł́AfactorialTu[`gĂяouċAĂяovsĂ܂B2ڂfactorialĂяołAŏ̌ĂяoƓlɒl1ȉǂ𔻒肵܂ǍĂяoł́A$numberł͂Ȃ$number-1ł邱ƂɒӂĂBwlɂĂfactorialTu[`xċAIɌĂяo邱ƂɂȂ܂AĂяoƂ$number̒l1炵Ă邽߁AĂяoivɌJԂƂ͂܂BƂΎwl4̂Ƃɂ́A4~3~2~1vZAu1傫vƂɍȂȂAׂĂfactorialTu[`Ăяo甲āAʂ\܂B

7.2FK
1.	̃XNvgsƏo͂鐔l͂łB

# v𒲂ׂ
#  sum.pl

# l
$sum = 10;

# Tu[`1Ăяo
&sum1( );

print "v: $sum\n";

# Tu[`1
sub sum1 {
  $sum++;
  {
    local($sum);
    $sum++;
    &sum2( );
  }
  &sum3( );
}

# Tu[`2
sub sum2 {
  $sum++;
}

# Tu[`3
sub sum3 {
  my($sum);
  $sum++;
}

yz
11
localmyŒ`ϐ́AǂTu[`𔲂_ŖɂȂ̂ŁAǁAŏ$sum++ӖƂɂȂ܂B

7.3FK
1.	nbṼt@X󂯎AL[ƒltɂĕԂTu[`쐬ÃTu[`gpXNvgȂB

qg reverse֐̈ɃnbVw肷ƁAL[ƒltɂł܂B

yz
# nbṼt@X
#  reference_hash.pl

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

# Tu[`sO
print "[sO]\n";
print "$key = $value\n" while (($key, $value) = each(%hash));

# t@XnăTu[`s
&sub_reference_hash(\%hash);

# Tu[`s
print "[s]\n";
print "$key = $value\n" while (($key, $value) = each(%hash));

# Tu[`
sub sub_reference_hash {
  # t@X󂯂
  my($reference_hash) = @_;

  # t@X̃nbV̓et]
  %$reference_hash = reverse (%$reference_hash);
}

2.	̃XNvĝATu[`trianglȅ𖳖Tu[`gďȂB

# Op`̖ʐς𒲂ׂ
#  triangle.pl

$base = 15;
$height = 20;

$area = &triangle($base, $height);
print " $base A $height ̎Op`̖ʐς $area łB\n";

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

yz
# Op`̖ʐς𒲂ׂ (Tu[`)
#  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 A $height ̎Op`̖ʐς $area łB\n";

7.4FK
1.	Ɏw肵2̒l̏i_ȉ͐؂̂ājԂTu[`܂񂾃W[ȂBȂA0Ŋ낤ƂƂɂ͕ERRԂ悤ɂȂB
yz
# 2̐l̏Ԃ
#  divide.pm

# Tu[`̒`
sub divide {
  my($number1, $number2) = @_;

  # l0̂Ƃɂ̓G[Ԃ
  return("ERR") if ($number2 == 0);

  # _ȉ͐؂̂ĂĕԂ
  int($number1 / $number2);
}

1;

	̃W[́Â悤ȃXNvgĂяo܂B

# divide.pmĂяo
#  divide_call.pl

# W[Ăяo
use divide;

print "Ώۂ̐l͂Ă: ";
$number1 = <STDIN>;
chomp($number1);
print "鐔l͂Ă: ";
$number2 = <STDIN>;
chomp($number2);

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

2.	JnƏIɎԂ\郂W[ȂBȂÃW[ł́ApackageXe[gggtimeƂpbP[W錾ȂB
yz
# JnƏIɎԂ\
#  time.pm

# pbP[WƂĐ錾
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 "Jn: ", &gettime( ), "\n";
}

# END[`
END {
  print "I: ", &gettime( ), "\n";
}

1;

	̃W[́Â悤ȃXNvgĂяo܂B

# timeW[Ăяo
#  time_call.pl

# pbP[WĂяo
use time;

print "EnterL[ĂB";
$key = <STDIN>;

	time.pmW[ł́Aԏ擾āu::bv`ŕԂgettimeTu[``Ă܂B܂ABEGIN[`END[``āAW[̊JnƏIgettimeTu[`Ăяo悤ɂĂ܂B
	time_call.plXNvgł́AuseXe[ggŃpbP[WĂяoƂƂɁA\ʂJnƏĨ^C~OmF₷A₷邽߂ɁAmEnternL[ŉs͂Ă܂B

7.5FK
1.	CwdW[gāÃ݂fBNg\ȂB

qg CwdW[cwd֐gpƁÃ݂fBNg擾邱Ƃł܂B
yz
# ݂̃fBNg̖O\
#  cwd_call.pl

# W[Ăяo
use Cwd;

# ֐Ăяoƕ\
print "݂̃fBNg: ", getcwd( ), "\n";

8.1FK
1.	Rs[̃t@CƃRs[̃t@C͂ƁAt@C̃Rs[sXNvgȂB
yz
# t@C̓eʂ̃t@C̃t@CɃRs[
#  copy.pl

print "Rs[̃t@Cw肵Ă: ";
$from_file = <STDIN>;
print "Rs[̃t@Cw肵Ă: ";
$to_file = <STDIN>;

chomp($from_file, $to_file);

# ꂼ̃t@CI[v
open(F, $from_file)   || die "$from_file I[vł܂:$!\n";
open(F2, ">$to_file") || die "$to_file 쐬ł܂:$!\n";

while (<F>) {
  # Rs[̃t@Cǂݍ݁ARs[̃t@Cɏo
  print F2;
}

close(F2);
close(F);

2.	[U[͂At@Cdictionary.txt̍ŌɒǉXNvg쐬ȂB
yz
# t@Cɒǉ
#  dictionary_append.pl

print "ǉ镶w肵Ă: ";
$input_str = <STDIN>;

open (F, ">>dictionary.txt") || die "t@CJ܂ł:$!\n";
  print F $input_str;
close(F);

3.	w肵t@CǂݎAt@CPerlƂ܂܂Ă邩ǂ𒲂ׂXNvg쐬ȂB
yz
# t@C當T
#  find.pl
print "t@Cw肵Ă: ";
$file_name = <STDIN>;
chomp($file_name);

open (F, "<$file_name") || die "t@CJ܂ł:$!\n";
  while (<F>) {
    if (/Perl/) {
      $match = 1;
      last;
    }
  }
close(F);

print $match ? "$file_nameɂ͕uPerlv܂܂Ă܂B\n" : "$file_nameɂ͕uPerlv܂܂Ă܂łB\n";

8.2FK
1.	L[{[h̓͂AL[[hEND܂񂾕񂪓܂ŁÂ܂ܕWG[o͂ɕ\XNvgȂB
yz
# W͂WG[Ƀ_CNg
#  redirect_stderr.pl

do {
  # W͂
  $string = <STDIN>;
  # WG[o͂ɂ̂܂܏o
  print STDERR $string;
  # END܂ޕ񂪂ƏI
} until ($string =~ /END/);

2.	1ڂ̈Ɏw肵t@CƌȂāÃt@CɕW͂ރXNvgȂBȂAw肳ĂȂƂɂ́AWG[o͂ɃG[bZ[W\ăXNvgIȂB
yz
# W͂t@Cɏo͂
#  std_file.pl

if (@ARGV < 1) {
  # 1w肳ĂȂ
  print STDERR "w肳Ă܂B\n";
  exit(1);
}

# 1ڂ̈t@CƂč쐬
open(F, ">$ARGV[0]") || die "$ARGV[0] 쐬ł܂:$!\n";
while (<STDIN>) {
  # W͂t@Cnhɏo
  print F;
}
close(F);

8.3FK
1.	w肵t@CƂĈÃt@C̏L҂[U[głAɃ[U[ǂݍ݌Ă΁ǍɉďL҂ƃO[v̏݌tXNvgȂB

qg ̌Ə݌0220̘_achmod̈Ɏw肵܂B

yz
# ̃t@CɌǉ
#  append_mod.pl

if (@ARGV > 0) {
  if (-o $ARGV[0]) {
    # L҂̃t@Cǂׂ

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

    # ǉ
    chmod($mode | 0220, $ARGV[0]);
  } else {
    print "L̃t@Cł͂܂B\n";
  }
} else {
  print "t@Cw肵ĂB\n";
}

2.	t@CƂĎ󂯎Ãt@C̗LmFAu<t@C>폜܂? (Y/N):vƂbZ[WoāAYꂽƂ̂݃t@C폜XNvg쐬ȂBAYNȊO͂̕ꂽƂ́AxAmFbZ[W\̂Ƃ܂B
yz
# t@C̍폜ɊmF
#  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͍폜ł܂łB
        :$!\n";
      last;
    } elsif ($answer eq 'N') {
      last;
    } else {
      print "Ȓl͂܂B\n";
    }
  }
} else {
  print "$filename݂͑܂B\n";
}

8.4FK
1.	݂̐efBNg̃t@Cꗗ\XNvgȂBAu.vƁu..v͎菜̂Ƃ܂B
yz
# efBNg̓eǂݍݕ\
#  parentdir.pl

# efBNgI[v
opendir(DIR, "..") || die ".. I[vł܂:$!\n";

# zɓǂݍ
@files = readdir(DIR);

# N[Y
closedir(DIR);

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

	Ō̃Xe[ggunlessȉ...OĂ邱ƂɒӂĂB\..GXP[vV[PXɂ́A{1,2}͒O̕1邢2AƂӖłB

8.5FK
1.	W͂ɓ͂R}hƂĎsXNvgAsystem֐gčȂB
yz
# system֐ɂCӂ̃R}h̎s
#  shell2.pl

print "sR}h͂Ă: ";
$command = <STDIN>;
chomp($command);

# w̃R}hs
system($command);

9.1FK
1.	PINGƓ͂PONGƕԎԂ11̃NCAg/T[o[VXeȂB
yz	
T[o[:

# PING/PONGT[o[
#  pingpongserver.pl

# W[̎gp錾
use IO::Socket;

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

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

# \Pbg
$server_socket->close( );

NCAg:

# PING/PONG NCAg
#  pingpongclient.pl

# W[̎gp錾
use IO::Socket;

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

# ͂T[o[ɑM
$string = <STDIN>;
print $client_socket $string;

# T[o[̏o͂Mĕ\
$receive = <$client_socket>;
print $receive;

# \Pbg
$client_socket->close( );

2.	1.̃T[o[𕡐̃NCAg̐ڑ悤ɉǂȂB
yz
# PING/PONGT[o[
#  pingpongserver2.pl

# W[̎gp錾
use IO::Socket;

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

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

# NCAg̓
do {
  $client_socket = $server_socket->accept( );
  if ($pid = fork( )) {
  }
  elsif (defined $pid) {
    $string = <$client_socket>;
    if ($string =~ /PING/) {
      # PONGo
      print $client_socket "PONG\n";
    }
    exit;
  } else {
    die "forkł܂B:$!\n";
  }
} until (0);

# \Pbg
$server_socket->close( );

3.	w肵URLWeby[W̍XVt擾AL^t@Cweb_record.logURLƓt^uŋ؂sǉXNvg쐬ȂB

qg GET̑HEADgƃwb_oƂł܂Bt́uDate: v̌ɏĂ܂B

yz
# Weby[WtWXNvg
#  collect.pl

# W[̎gp錾
use IO::Socket;

# URL
print "URLw肵Ă: ";
$url = <STDIN>;

# URLzXgƃt@CpXɕ
chomp($url);
if ($url =~ /http:\/\/([^\/]+)(\/.*)/) {
  $host = $1;
  $file = $2;
} else {
  die "URLɂ͑ΉĂ܂B\n";
}

# L^t@CJ
open(F, ">>web_record.log");

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

# ͂T[o[ɑM
print "$host $file" . "\n";
print $client_socket "HEAD $file HTTP/1.0\n\n";
# o͂擾A\(sԂĂ̂ŁAI܂Ń[v)
while ($receive = <$client_socket>) {
  print $receive;
  # 2sĂ邱Ƃ̂ŁAt@Cɏo͂Oɏ
  chomp($receive); chomp($receive);
  if ($receive =~ /^Date: (.*)/) {
    # toAt@Cɒǉ
    $date = $1;
    print F "$url\t$date\n";
  }
}

# \Pbg
$client_socket->close( );
# t@Cnh
close(F);

10.1FK
1.	1HTMLt@Ĉꂼ̃^Oǂ̂悤ȈӖׂȂB
yz
iȗj

10.2FK
1.	gpOS𕡐Ił悤ɗ2̃XNvgCȂB
yz
#!/usr/bin/perl
# AP[gCGIvOXNvg(lΉ)
# [U[gĂOS̍v𒲂ׂ
#  questionnaire3.cgi

# W[ǂݍ
use CGI;
$query = new CGI;

# vt@C݂̑̃`FbN
if (-f "data/statistic3.log") {
  # ݂Ȃt@CI[vBsG[y[W\
  open(F, "data/statistic3.log") ||
    &error("t@C data/statistic3.log I[vł܂ ($!) B
           \n");
  while (<F>) {
    # s
    chomp( );
    # OOSApr擾
    ($name, $os, $use) = split(/\t/);
    # z@nametotalɖO~
    push(@nametotal, $name);
    # nbV$ostotalɍvl~
    # ,ŋ؂Ă̂ŕ
    foreach (split(/,/, $os)) {
      $ostotal{$_}++;
    }
    # nbV$usetotalɍvl~
    # ,ŋ؂Ă̂ŕ
    foreach (split(/,/, $use)) {
      $usetotal{$_}++;
    }
  }
  close(F);
}

# AP[g
# O^u菜(t@C̃f[^̋؂ɂĂ邽)
$name = $query->param('name');
$name =~ s/\t//g;
# OɏdȂ
foreach (@nametotal) {
  if ($_ eq $name) {
    # ̂Ƃɂ̓G[y[W\
    &error("O $name ͂łɓo^Ă܂B\n");
  }
}

# XgosɓĂOSnbVɒǉ
foreach ($query->param('os')) {
  $ostotal{$_}++;
}

# XguseɓĂprnbVɒǉ
foreach ($query->param('use')) {
  $usetotal{$_}++;
}

# L^ɒǉBsG[y[W\
open(F, ">>data/statistic3.log") ||
  &error("t@C data/statistic3.log ɏ߂܂ ($!) B\n");
# XgosAuse,ŋ؂ɂď
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=>"݂̃AP[g");
print "<h2>gpOS</h2>\n";
print "<ul>\n";
# v\
print "<li><strong>$os</strong>: $count</li>\n"
  while (($os, $count) = each (%ostotal));
print "</ul>\n";

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

print $query->end_html( );

sub error {
  # G[y[W\̃Tu[`
  my($message) = @_;

  print $query->header(-charset=>'Shift_JIS'), 
    $query->start_html(-title=>"G[");
  print "<h1>G[܂B</h1>\n";
  print $message;
  print $query->end_html( );
  # ُI
  exit(1);
}

10.3FK
1.	1̃XNvgǂAMozillaƂL[[h܂łȂuEUƁAzXg.jpȊOŏIĂzXg̃Abv[h֎~ȂB
yz
#!/usr/bin/perl
# tt@C\CGIvOXNvg
#  fileinfo2.cgi

# W[ǂݍ
use CGI;
$query = new CGI;
$filename = $query->param('filename');

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

# \
print $query->header(-charset=>'Shift_JIS'), 
  $query->start_html(-title=>"t@C");

print "<h2>t@C</h2>\n";
print "<ul>\n";
# XJ[ϐƂĈƃt@CԂ
print "<li>t@C:", $filename, "</li>\n";
print "<li>t@CMIME^Cv:",
  $query->uploadInfo($filename)->{'Content-Type'} , "</li>\n";
print "</ul>\n";

print "<h2>t@Ce</h2>\n";
print "<PRE>\n";
while (<$filename>) {
  # t@C̓e\
  print;
}
print "</PRE>\n";
print $query->end_html( );

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

  # ۃbZ[W\
  print "<p>",
  "Ȃ̃zXg邢̓uEŨANZX͋ۂ܂B",
  "</p>\n";
  print $query->end_html( );

  # ُI
  exit(0);
}

11.1FK
1.	CPUAAn[hfBXNȂǂm[hƂĂȂ̃Rs[^̍\XMLŕ\ȂB
yz
iȗj

2.	ȂgĂVXeł͂ǂ̂悤ȕ^`pł邩ׂȂB
yz
iȗj

11.2FK
1.	ō쐬XMLp[TXNvggāAK11.1ō쐬XMLhLg͂ȂB

2.	XML󂯎Đ`ǂparse֐ŒׁA`ɍvĂ΁uXMLhLgłBvƃuEUɕԂWeb CGIC^[tFCX쐬ȂBA`ɍvĂȂƂ́AusXMLhLgłBvƂƁAG[bZ[W̗ԂȂB

qg eLXgCGIŎ󂯕t邽߂ɁAHTML̃tH[Ƃ<textarea>vfgƂ悢ł傤B<textarea name="xml" cols=60 rows=30></textarea>̂悤ɋLq܂B

yz
HTMLt@Ĉ͎悤ɂȂ܂B

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
<!--
 XMLhLgt@C󂯕tHTML

 xmlinfo.html
-->
<html>
  <head>
    <title>XMLhLgp[T</title>
  </head>

  <body>
    <h1>XMLhLgp[T</h1>

    <p>͂XMLhLgLāmMnĂB</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="M"><br>
        <input type="reset" value="Zbg">
      </p>
    </form>

  </body>
</html>

CGIvÔ͎悤ɂȂ܂B

#!/usr/bin/perl
# XMLp[TCGIvOXNvg
#  xmlinfo.cgi

# W[ǂݍ
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>sXMLhLgłB</p>\n";
  print "<PRE>\n";
  # G[bZ[W\
  print $@;
  print "</PRE>\n";
} else {
  print "<p>XMLhLgłB</p>\n";
}
print $query->end_html( );

11.3FK
1.	XMLhLgAnameAaddressAtel̗vf̒l𔲂oAuO,Z,dbԍv̌`iCSV`jŏo͂sXNvgȂB

<?xml version="1.0" encoding="utf-8"?>
<addressbook>
  <title>Z^</title>
  <info>
    <name></name>
    <address>scJ</address>
    <tel>03-XXXX-XXXX</tel>
  </info>
  <info>
    <name>Rc</name>
    <address>{s</address>
    <tel>06-XXXX-XXXX</tel>
  </info>
  <info>
    <name></name>
    <address>{錧s</address>
    <tel>022-XXX-XXXX</tel>
  </info>
</addressbook>

yz
# Z^CSV쐬
#  addressbook.pl
use encoding "utf8", STDOUT=>"Shift_JIS";
use XML::Parser;

# nhtŃIuWFNg쐬
$parser = new XML::Parser( Handlers => 
				   {Start=>\&element_start,
				    Char => \&cdata,
				    End => \&element_end});

# vfۑϐ
$element_name = '';
# Z^
%records = {};

# ͂̎s
eval ( "\$parser->parsefile( \@ARGV[0] );");

if ($@) {
  chomp($@);
  $@ =~ s/^\n//;
  $@ =~ s/ at (?:[A-Z]:)?\/.*//;
  print @ARGV[0] . "͕sXMLhLgł (G[: $@)B\n";
}

sub element_start {
  # vf̊Jn
  my ($expat, $name, %attributes) = @_;
  $element_name = $name;
  # nbV
  $records = {} if ( $name eq 'info' );
}

sub element_end {
  # vf̏I
  my ($expat, $name) = @_;
  if ( $name eq 'info' ) {
    # nbVo
    print $records{'name'} . "," . $records{'address'} . "," 
      . $records{'tel'} . "\n";
  }
  $element_name = '';
}

sub cdata {
  # eLXgf[^
  my ($expat, $context) = @_;
  # nbVɊi[
  $records{$element_name} = $context if ($element_name);
}

sʂ͎̂悤ɂȂ܂B

,scJ,03-XXXX-XXXX
Rc,{s,06-XXXX-XXXX
,{錧s,022-XXX-XXXX

11.4FK
1.	11.4 1.XPathXNvggāA낢ȃpX̕\Ă݂ȂB
yz
iȗj
