perl-引用，没有理太多理论，都是案例

#!/usr/bin/perl 
use strict;
use warnings;

=pod
  子列程的引用
=cut

#一个变量或一个复杂的数据结构是是整个程序的数值仓库
#一个子例子程的引用可以被想象成一个程序中的行为仓库


#命名子例子程的引用

sub skipper_greets
{
   my $person = shift;
   print "Skipper: Hey there,$person\n";
}

sub gilligan_greets
{
   my $person = shift;
   if($person eq "Skipper")
   {
     print "Gilligan: Sir,yer,sir, $person\n";
   }
   else
   {
      print "Gilligan: Hi,$person\n";
   }
}

sub professor_greets
{
   my $person = shift;
   print "Professor: By my caculations,you must be $person\n";
}
print '-' x 80,">\n";
skipper_greets("Gilligan");
gilligan_greets("Skipper");
print '-' x 80,">\n";

professor_greets("Gilligan");
professor_greets("Skipper");
print '-' x 80,">\n";


#取引用

my $ref_to_greeter = \&skipper_greets;

#解引用
#[1]=
&{$ref_to_greeter}('Gilligan');
#[2]=
& $ref_to_greeter('Skipper');
#[3]=
$ref_to_greeter->('Skipper');
print '-' x 80,">\n";
#如果想要让Gilligan and Skipper to Professor问好,我们只需要能过迭代调用所的子例程:
for my $greet (\&skipper_greets,\&gilligan_greets)
{
     $greet->('Professor');
}
print '-' x 80,">\n";

#首先,在小括号里面,创建一个包含两个元素的列表,而且每个元素是一个代码引用,
#每个代码引用都各自被解引用,即调用相应的子例子程并且传递"Professor"字符串。





#把这些引用放入一个更大的数据结构中,让他们之间有相互问候的行为:

sub skippers
{
   my $person = shift;
   print "Skipper: Hi there, $person\n";
}

sub gilligans
{
   my $person = shift;
   if($person eq "Skipper")
   {
     print "Gillgian: yes,sir,$person\n";
   }
   else
   {
     print "Gilligan:Hi,$person\n";
   }
}

sub professors
{
   my $person = shift;
   print "Professor: By my calculations,you must be $person\n";
}

my %greeters=(
   'Skipper'   =>\&skippers,
   'Gilligan'  =>\&gilligans,
   'Professor' =>\&professors,
);

for my $person (qw(Skipper Gilligan))
{
   $greeters{$person}->("Professor");
}

print '-' x 80,">\n";

my @everyone = sort keys %greeters;

for my $greeter (@everyone)
{
   for my $greeted(@everyone)
   {
      $greeters{$greeter}->('greeted')
        unless $greeter eq $greeted; #no talking to yourself
   }
}
print "@everyone\n";
print '-' x 80,">\n";

#让他们一个个走进房间
my @room; #initially empty
for my $person(qw(Gilligan Skipper Professor))
{
  print "\n";
  print "$person walks into the room.\n";
  for my $room_person(@room)
  {
    $greeters{$person}->("$room_person"); #speak
    $greeters{$room_person}->("$person");
  }
  push @room,$person;
}

print '-' x 80,">\n";



=pod
  匿名子例子程
=cut

my $giner = sub{
    my $person = shift;
    print "Gilligan:(in a sultry voice) well hello,$person\n";
   };

$giner->('Skipper');
print '-' x 80,">\n";

my %greets=(
    Skipper => sub
    {
       my $person = shift;
       print "Skipper:Hey there,$person\n",
    },
    Gilligan => sub
    {
       my $person = shift;
       if($person eq "Skipper")
       {
         print "Gillian:Sir,yer,sir,$person\n";
       }
       else
       {
          print "Gillian:Hi,$person\n";
       }
    },
    Professor => sub
    {
       my $person = shift;
       print "Proessor: By my calculations,you must be $person\n";
    },
    Giner => sub
    {
       my $person = shift;
       print "Ginger: (in a sultry voice) well hello,$person\n";
    },
   );

print "#======>\n";
my @rooms; #initially empty
my ($num,$count);
for my $persons (qw(Gilligan Skipper Professor Giner))
{
    print "\n";
    print "$persons walks into the room.\n";
    for my $room_persons (@rooms)
    {
       $greets{$persons}->($room_persons);
       $greets{$room_persons}->($persons);
    }
    push @rooms,$persons;
    print '-' x 80,">\n";
}


print "\n";
print '-' x 80,">\n";


=pod
  回调

一个子例子程引用经常被用于回调。回调定义在一个算法中当子例程运行到一个特定
的位置所做的事情。它给我们一个机会来提提供自己的子例程.
=cut


use File::Find;

sub wanted_to_do
{
    print "$File::Find::name found.\n";
}

my @starting_directories=qw(.);
find(\&wanted_to_do,@starting_directories);

print '-' x 80,">\n";

my @dirs=qw(.);
find(
   sub
   {
       print "$File::Find::name found.\n";
   },@dirs,
);

print '-' x 80,">\n";



=pod
  闭包
=cut

{
   my $inc = 10;
   sub inc 
   {
      print "$inc\n";
      $inc++;
   }
}
inc(); #10
inc(); #11
#这个例子说了命名函数默认是全局的,即使在定定义在一个block里面.
#我们不能引用引用变量$inc,但是却可以调用函数

print '-' x 80,">\n";

#[2]
sub make_inc
{
    my $inc = shift;
    return sub { print "$inc\n"; $inc++};
}

my $c1=make_inc(10);
my $c2=make_inc(20);

$c1->(); #10
$c2->(); #20
$c1->(); #11
$c2->(); #21

print '-' x 80,">\n";
#这个子例程我看到了,perl函数返回其实就是一个匿名函数,这个就是
#magic所在了.这个也是perl如何实现闭包的。

#[3]

sub exlaim
{
   my $prefix = shift;
   return sub {print "$prefix $_[0]\n"};
}

my $batman = exlaim('Indeed');
my $robin  = exlaim('Holy');

$robin->('Mackerel'); #prints:Holy Makcerel!
$batman->('Robin') ; #prints: Indeed Robin!
print '-' x 80,">\n";


#闭包有什么作用呢？

#用法一,在subroutine中返回subroutine的引用,通常作为回调函数:

sub create_find_callbaks_that_sum_the_size
{
    my $total_size = 0;
    return (sub { $total_size += -s if -f},sub {return $total_size})
}

my ($count_em,$get_results) = create_find_callbaks_that_sum_the_size();
find ($count_em,'/bin');
my $total_size = &$get_results();
print "total size of bin is $total_size\n";

print '-' x 80,">\n";


#这段代码用于计算某个目录所包含的所有文件的大小之和

#用法二,使用闭环境变量作为输入,用作函数生成器,来生成不同的函数指针:

sub print_bigger_than
{
    my $minimum_size = shift;
    return sub {print "$File::Find::name\n"if -f and -s >= $minimum_size};
}

my $bigger_than_1024 = print_bigger_than(1024);

find($bigger_than_1024,'/bin');

#print_bigger_than在这里相当于一个函数生成器,不同的输入变量可以生成不同的函数指针,
#这里生成了一个可以打印出文件大小大于1024字节的文件名的回调函数.
print '-' x 80,">\n";


#用法三,用为静太局部变量使用,提供了C语言静太局部变量的功能:
BEGIN 
{
    my $countdown = 10;
    sub countdown { $countdown--}
    sub count_remaining {$countdown}
}

#这里的关键字BEGIN. BEGIN的作用就是,当perl编译完这段代码之后,停止当前
#编译,然后直接进入运行阶段,执行BEGIN块内部的代码,然后在回到编译状态，
#继续编译剩余的代码.这就保证了无论BEGIN块位于程序中的哪个位置,在调用
#countdown之前,$countdown被确保初始化为10.

#练习
#[1] 从一个子例程返回另一个子例程

sub create_find_callback_tha_counts
{
    my $count = 0;
    return sub {print ++$count, "$File::Find::name\n"};
}

my $call_back= create_find_callback_tha_counts();
print "./:\n";
find($call_back,'./');
print '-' x 80,">\n";
print "/bin\n";
#find($call_back,'/bin'); #继续计数
print '-' x 80,">\n";


my $call_back2=create_find_callback_tha_counts();
find($call_back2,'/bin');
print '-' x 80,">\n";

sub callback_sums_size
{
   my $total_size = 0;
   return sub 
          {
             if(@_)
             { #it's our dummy invocation
               return $total_size
             }
             else
             {
                $total_size += -s if -f;
             };
          }
}

my $call_size_back=callback_sums_size();
find($call_size_back,'/bin');
my $size = $call_size_back->('dummy');#dummy parameter to get size
print "total size of bin is $size\n";

print '-' x 80,">\n";

sub total_size
{
    my $total_size = 0;
    return(sub {$total_size += -s if -f},sub {return $total_size});
}
my ($em,$re)=total_size();
find($em,'/bin');
my $t_size=&$re();
print "Total size of bin is $t_size\n";
print '-' x 80,">\n";

#多次调用
sub create_sum_the_size
{
   my $total_size = 0;
   return(sub {$total_size += -s if -f },sub {return $total_size});
}

###set up subroutines
my %subs;
foreach my $dir(qw(/bin /lib /etc))
{
   my ($callback,$getter) = create_sum_the_size();
   $subs{$dir}{CALLBACK}=$callback;
   $subs{$dir}{GETTER}=$getter;
}
###gather the data
for (sort keys %subs)
{
   find($subs{$_}{CALLBACK},$_);
}

###show the data
for (sort keys %subs)
{
   my $sum = $subs{$_}{GETTER}->();
   print "$_ has $sum bytes\n";
}

print '-' x 80,">\n";

#####################################################

=pod
 state变量
 是另一种私有的,持续的变量 
=cut

use v5.10;

sub countdown1
{
  state $countdown = 10;
  $countdown--;
  return $countdown;
}
print countdown1(),"\n"; 
print countdown1(),"\n"; 

print '-' x 80,">\n";

use v5.10;
my @arrary = qw(a b c d e f 1 2 3);
print sort {
      state $n = 0;
      print $n++, "a[$a] b[$b]\n";
      $a cmp $b;
      }@arrary;


print '-' x 80,">\n";
print "\n";
#查我们自己的身份
=pod
  匿名子例程有一个身份问题;它们不知道它们是谁!虽然我们不在呼它们是否有名称,但是
当需要告诉我们它们的身份名称是什么时,有一个名称就显得很便捷。假如我们想要使用匿名子例程编写一个递归子例程.当它还没有完成创建时,我们将使用什么名称再次调用相同的子例程？
=cut
use v5.14;
=pod
my $numdow = sub {
             state $n = 5;
             return unless $n > -1;
             say $n--;
             WHAT_NAME???->();
             };
=cut

use v5.14;
my $numdown;
$numdown = sub
{
   state $n = 5;
   return unless $n > -1;
   say $n--;
   $numdown->();
};
$numdown->();
print '-' x 80,">\n";

=pod
Perl:使用__SUB__获得当前子程序的引用
 首先,考虑一下在没有__SUB__特性的时候,你是怎么做的.你可能会声明一个变量用来保存子程序引用,
然后在下一条语句中定义那个子程序.由于你已经声明了那个变量,所以你可以在子程序中使用它.虽然
在定义的时候那个变量还不是引用,但也没关系,因为Perl只会在真正运行子程序的时候才会对它解引用
=cut

use v5.10;
my $sub;
$sub = sub
       {
          state $count = 10;
          say $count;
          return if --$count < 0;
          $sub->();
       };
$sub->();

print "\n";
print '-' x 80,"->\n";
#这种写法两个限制:一个是代码引用必须存储在一变量中,还有就是这个变量必须被已经定义,这种限制经
#常会带来一些不便,你是的匿名子程序还包含了自身的引用,所以你需要使用弱引用的技巧否则就让这个
#引用一直存在下去,这两种结果都不是我们想要的.

#Rafaël Garcia-Suarez解决了这个问题,它创建的Sub::Current模块可以给你提供一个ROUTINE函数,
#该函数会返回当前子程序的引用,即使该 程序是一个命名子程序:

use v5.10;

use Sub::Current;

sub condown
{
    state $count = 10;
    say $count ;
    return if --$count < 0;
    ROUTINE->();
}

condown();
print '-' x 80,"->\n";

#你也许想要把代码这样代码引用定义一条单独的语句,即使你不需要这么做,
#比如你想要把代码引用定义在参数列表中:
use v5.10;
use Sub::Current;

sub run {$_[0]->()}
print "run:\n";
run ( sub {
      state $count = 10;
      say $count;
      return if --$count < 0;
      ROUTINE->();
      });
print '-' x 80,"->\n";

#你也许还需要把子程序作为返回值定义在一条语句中:

use v5.10;
use Sub::Current;
sub factory
{
    my $start = shift;
    sub 
    { 
       state $count = $start;
       say $count;
       return if --$count < 0;
       ROUTINE->();
     }
}

factory(4)->();
print '-' x 80,"->\n";


#使用这个模块的缺点就是对CPAN的依赖,虽然它是一个轻量级的,还有另一
#个模块Deval::Caller,由Richard Clamp编写，它可以获取调用栈中在任意层
#级的代码引用,包括当前层级:

use v5.10;
use Devel::Caller qw(caller_cv);
print "factory1:\n";
sub factory1
{
   my $start = shift;
   sub 
   {
      state $count = $start;
      say $count;
      return if --$count < 0;
      caller_cv->();
   }
}

factory(7)->();
print '-' x 80,"->\n";

#perl5.16可以让你实现相现的功能而不需要任何CPAN模块:

use v5.16; #until v5.16 is released

sub factory2
{
   my $start = shift;
   sub
   {
      state $count = $start;
      say $count;
      return if $count < 0;
      __SUB__->();
   }
}

print "factory2:\n";
factory2(7);

print '-' x 80,"->\n";

use v5.10;
use feature qw(say state current_sub);

sub factory3 {
    my $start = shift;
    sub {
        state $count = $start;
        say $count;
        return if --$count < 0;
        __SUB__->();
        }
    };
print "factory3:\n"; 
factory3(7)->();
print '-' x 80,"->\n";



#other

use v5.10;
my @array = (\ 'xyz',[qw(a b c)],sub{ say 'Buster'});

foreach (@array)
{
   when( ref eq ref \ '' ) 
   {
     say "Sclar $$_"
   }
   when(ref eq  ref [])
   {
     say "Array @$_"
   }
   when(ref eq ref sub {})
   {
      say "Sub ???"
   }
}




use v5.14;

package MagicalCodeRef 1.00
{
   use overload '""' => sub
   {
     require B;

     my $ref = shift;
     my $gv = B::svref_2object($ref)->GV;

     require B::Deparse;
   }
}