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