1 #-----------------------------------------------------------#
  2 # Source: Learning Perl, chapter4
  3 # Date:   2012-01-14
  4 # Author: xiaodongrush
  5 #-----------------------------------------------------------#
  6 #                          code-1                           #
  7 #-----------------------------------------------------------#
  8 $split = "-------------------------------------------------";
  9 $code1 = 'sub sum {'                   . "\n" .
 10          '  my $result = 0;'           . "\n" .
 11          '  foreach(@_) {'             . "\n" .
 12          '    $result += $_;'          . "\n" .
 13          '  }'                         . "\n" .
 14          '  $result;'                  . "\n" .
 15          '}'                           . "\n" .
 16          'print &sum(1,3,5,7,9). "\n";';
 17 print "code-1\n" . $code1 . "\n" . $split;
 18 #-----------------------------------------------------------#
 19 #                          execute-1                        #
 20 #-----------------------------------------------------------#
 21 print "\nexecute-1\n";
 22 sub sum {
 23   my $result = 0;
 24   foreach(@_) {
 25     $result += $_;
 26   }
 27   $result;
 28 }
 29 print &sum(1,3,5,7,9) . "\n";
 30 #-----------------------------------------------------------#
 31 #                          code-2                           #
 32 #-----------------------------------------------------------#
 33 $code2 = 'print &sum(1..1000) + "\n";';
 34 print $split . "\ncode-2\n" . $code2 . "\n" . $split;
 35 #-----------------------------------------------------------#
 36 #                          execute-2                        #
 37 #-----------------------------------------------------------#
 38 print "\nexecute-2\n";
 39 print &sum(1..1000) . "\n";
 40 #-----------------------------------------------------------#
 41 #                          code-3                           #
 42 #-----------------------------------------------------------#
 43 $code3 = 'sub average {'                                           . "\n" . 
 44          '  my $result = 0;'                                       . "\n" .
 45          '  if(@_ == 0) { return 0; }'                             . "\n" .
 46          '  foreach(@_) { $result += $_; }'                        . "\n" .
 47          '  $result /= @_;'                                        . "\n" .
 48          '}'                                                       . "\n" .
 49          'sub above_average {'                                     . "\n" .
 50          '  my @array;'                                            . "\n" .
 51          '  my $aver = &average(@_);'                              . "\n" .
 52          '  foreach(@_) { if($_ > $aver) { push(@array, $_); } }'  . "\n" .
 53          '  @array;'                                               . "\n" .
 54          "}"                                                       ;
 55 print $split . "\ncode-3\n" . $code3 . "\n" . $split;
 56 #-----------------------------------------------------------#
 57 #                          execute-3                        #
 58 #-----------------------------------------------------------#
 59 print "\nexecute-3\n";
 60 sub average {
 61   my $result = 0;
 62   if(@_ == 0) { return 0; }
 63   foreach(@_) { $result += $_; }
 64   $result /= @_;
 65 }
 66 sub above_average {
 67   my @array;
 68   my $aver = &average(@_);
 69   foreach(@_) { if($_ > $aver) { push(@array, $_); } }
 70   @array;
 71 }
 72 print &average(1..10) . "\n";
 73 foreach(&above_average(1..10)) { print $_ . "\n";}
 74 #-----------------------------------------------------------#
 75 #                          code-4                           #
 76 #-----------------------------------------------------------#
 77 $code4 = 'use feature qw(state);'                                  . "\n" . 
 78          'sub greet {'                                             . "\n" .
 79          '  state $last_name = undef;'                             . "\n" .
 80          '  print "Hi " . @_[0] . "! ";'                           . "\n" .
 81          '  if($last_name eq undef) { print "You are the first one here!\n"; }'   . "\n" . 
 82          '  else { print "I\'ve seen: " . $last_name . "\n";}'     . "\n" .
 83          '  $last_name = @_[0];'                                   . "\n" .
 84          '}'                                                       . "\n" .
 85          '&greet("Fred");'                                         . "\n" .
 86          '&greet("Barney");'                                       ;
 87 print $split . "\ncode-4\n" . $code4 . "\n" . $split;
 88 #-----------------------------------------------------------#
 89 #                          execute-4                        #
 90 #-----------------------------------------------------------#
 91 print "\nexecute-4\n";
 92 use feature qw(state);
 93 sub greet {
 94   state $last_name;
 95   print "Hi " . @_[0] . "! ";
 96   if(!defined($last_name)) { print "You are the first one here!\n"; }
 97   else { print "I've seen: " . $last_name . "\n";}
 98   $last_name = @_[0];
 99 }
100 &greet("Fred");
101 &greet("Barney");
102 #-----------------------------------------------------------#
103 #                          code-5                           #
104 #-----------------------------------------------------------#
105 $code5 = 'use feature qw(state);'                                  . "\n" . 
106          'sub greet_version2 {'                                    . "\n" .
107          '  state @last_names;'                                    . "\n" .
108          '  print "Hi " . @_[0] . "! ";'                           . "\n" .
109          '  if(@last_names == 0)  { print "You are the first one here!\n"; }'
110                                                                    . "\n" . 
111          '  else {'                                                . "\n" .
112          '    print "I\'ve seen: ";'                                . "\n" .
113          '    foreach(@last_names) { print " " . $_; }'            . "\n" .
114          '    print "\n";'                                         . "\n" .
115          '  }'                                                     . "\n" .  
116          '  push(@last_names, @_[0]);  '                           . "\n" .  
117          '}'                                                       . "\n" .
118          '&greet_version2("Fred");'                                . "\n" .
119          '&greet_version2("Barney");'                              . "\n" .
120          '&greet_version2("Wilma");'                               . "\n" .
121          '&greet_version2("Betty");'                               ;
122 print $split . "\ncode-5\n" . $code5 . "\n" . $split;
123 #-----------------------------------------------------------#
124 #                          execute-5                        #
125 #-----------------------------------------------------------#
126 print "\nexecute-5\n";
127 use feature qw(state);
128 sub greet_version2 {
129   state @last_names;
130   print "Hi " . @_[0] . "! ";
131   if(@last_names == 0) { print "You are the first one here!\n"; }
132   else { 
133     print "I've seen: ";
134     foreach(@last_names) { print " " . $_; }
135     print "\n";
136   }
137   push(@last_names, @_[0]);   
138 }
139 &greet_version2("Fred");
140 &greet_version2("Barney");
141 &greet_version2("Wilma");
142 &greet_version2("Betty");
143 #-----------------------------------------------------------#
144 print "END!!!";
145 <STDIN>
146 #-----------------------------------------------------------#
147 # 总结
148 # 1. 子程序定义用sub关键字，子程序调尽量用&（当与内置函数重名，
149 #    或者函数定义在函数调用之后时，必须用&）
150 # 2. 子程序参数列表：@_，子程序返回值：最后一行，或者return。
151 # 3. state这个是在perl 5.0.10里面提供的功能，要么加入use feature qw(state);
152 #    要么加入use 5.010;
153 # 3. reverse，sort，这些函数与chomp不同，更像返回值，而chomp直接修改了原数组，或者原变量
154 # 4. 字符串判断是否存在用：$last_name eq undef
155 # 5. 单引号字符串内的单引号需要转义
156 #    '  else { print "I\'ve seen: " . $last_name . "\n";}'     . "\n" .
157 # 6. 私有持久列表变量不能初始化，即state @array = undef; 这是错误的。
158 # 7. 标量在没有被赋值前，是undef状态，undef在数值上下文中，转化为0，
159 #    在字符串上下文，转化为空串，判断一个变量是否是undef状态，用defined($_var)
160 # 8. 数组在没有被赋值前，不是undef状态，仅仅是个空数组，判断其是否为空：@array == 0