perl学习笔记(二)

#!/usr/bin/perl

use 5.010;

#词法与动态作用域
$a = 20; #全局变量
{
    local ($a); #临时变量,保存全局变量,新值为undef
    $a = 10;
    #say $a;
}
#say $a;

#Typeglob创建标识符别名
#local临时别名
$b = 30;
{   
    #local (*b);
    local *b; #创建临时别名（保存全局*b的值,然后将新值赋为undef）
    *b = *c;  #创建变量c的别名b
    $b += 10;
}
say $c;
say $b;
say "----------------------";
@array = (10,20);
&define_function(*array);
*fun = *define_function;#给函数定义别名
&fun(*array);#给函数定义别名
#my @array = (10,20);
#&fun(*array);
say "@array";
sub define_function{
    local *copy = shift;
    foreach (@copy) {
        $_ *=2;
    }
}
say "----------------------";
$x = 10;
&foo(*x);
sub foo{
    local (*y) = @_;
    say "before....$y";
    local ($x) = 100;
    say "aftet....$y";
}
say $x;

#创建只读变量
*num = \10.11;
say $num;
#$num =10;#修改将会报错

#为匿名子例程定义别名
sub operate{
    my($greting) = @_;
    sub{say "$greting world";}
}
$rs = operate("hello");
#&$rs();
*greting = $rs;#定义别名
greting();#等价于 &$rs


#I/O重定向
#open(F,'>>io.txt')|| die 'cannot io opera';
#*STDOUT = *F;#别名
#say 'Hello World.';

#把文件句柄传递给子例程
open(F,'>io.txt') || die 'cannot sent.$!';
sub read_and_print{
    local (*G) = @_; #文件句柄G与文件句柄F相同
    while(<G>){
        say 'cannot send..';
    }
    say 'cannot send..';
}
&read_and_print(*F);

#close(F);

#子例程引用
sub greet{
    say "hello";
}
$rs = \&greet;#对有名子例程的引用;
#$rs = \&greet();#错误
#对匿名子例程的引用
$rs = sub{
    say "hello";
};
#对子例程引用的间接访问(2种方式)
&$rs(10,20);
$rs->(10,30);

#如果中间的调用同样返回对子例程的引用的话,子例程调用可以连接起来
sub test1{
    my $args = shift;
    say "$args";
    return \&test2;
}
sub test2{
    my $args = shift;
    say " and $args";
}
$rs = \&test1;
$rs->("hellos")->("worlds");

#符号引用(引用的只是字符串而不是真正的引用)
sub foo{
    say "foo called!";
}
$rs = "foo";
&$rs();
say '----------调度表demo-------------';
#使用子例程引用(回调函数)
#调度表(#rl为数组引用，rh为散列表引用)
@ARGV = ("-f","-r",'aa','-h');
%options = (
    "-h"    =>      \&help,
    "-f"    =>      sub{$askNoQuestions = 1;say '-f...called'},
    "-r"    =>      sub{$recursive = 1;say '-r...called'},
    "-default"   =>    \&default,
);
&processArgs(\@ARGV,\%options);
sub default{
	say "sub default called!";
}
sub processArgs{
	my($rlArgs,$rhOptions) = @_;
	foreach $arg(@$rlArgs){
		if(exists $rhOptions->{$arg}){
			#$rsub = $rhOptions{$arg};
			#&$rsub();
			&{$rhOptions->{$arg}}();
		}else{
			if (exists $rhOptions->{"-default"}) {
				&{$rhOptions->{"-default"}}();
			}
		}
	}
}
sub help{
	say 'help..called';
}

say "----------------eval-------------------------------------";
$str = '$a=10;$b=20;$a+$b';
$re = eval $str;
say $re;
eval{
	$a = 10;
	$b = 0;
	$c = $a / $b;
};
say $@;#异常信息保存在$@
say "----------------eval表达式计算--------p112-----------------------------";
#$str = 2 * log(10);
$str = 10+10;
$str = 'aaa"saas"';
$str = 'for(1..10){say $_,"->"}';
while(defined($str)){
	$result = eval $str;
	if($@){
		say "Invalid string:$str";
	}else{
		say "$result";
	}
	last;
}
say "----------------超时中使用eval-----------------------------";
sub time_out{
	die "GOT TIRED OF WAITING";
}
$SIG = \&time_out;
eval{
	alarm(10);#10秒后终止
	$bug = <>;
	alarm(0);
};
if($@ =~ /GOT TIRED OF WAITING/){
	print "Timed out.Processing with default.";
}