perl随记

 #!/usr/bin/perl 
use strict;
use warnings;
use v5.14;

=pod
  检查所携带的的供应物品
=cut
#必带品
my @require=qw(prescer sunscreen water_bottle jacket);

#查检gilligan所带的物品
my %gilligan = map {$_,1}qw(red_shirt hat lucky_socks water_botter);

foreach my $item (@require)
{
    #not in list
    say "Gilligan is missing $item" unless $gilligan{$item};
}

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

#检查professor所带物品
my %professor = map {$_,1}qw(sunscreen water_bottle slide_rule batteries radio);
foreach my $item (@require)
{
  say "Professor is missing $item" unless $professor{$item};
}

=pod
   如果这样编写代码,就会现有太多的重复的代码,下面的列子将考虑代码重构
=cut

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

sub check_requrie_item
{
   my $who = shift;
   my %who_item = map {$_,1}@_; #the reset are the person's item

   my @require=qw(prescer sunscreen water_bottle jacket);

   foreach my $item (@require)
   {
      say "$who is missing $item" unless $who_item{$item};
   }
}

=pod
  通过参数列表，也就是@_，向子例程传入5项
=cut
my @Gilligan_new=qw(red_shirt hat lucky_socks water_botter);
&check_requrie_item("Gilligan_new",@Gilligan_new);






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

=pod
  通常情况下，变量的所有引用在变量销毁之前都销毁了
但是如果其中一个引用比变量名存在的更久会怎么样？例如，
考虑运行下代码将会得的输出
=cut

my $ref;
{
   #//该作用结束后，@skipper被销毁
   my @skipper =qw(blue_shirt hat jacket preserver sunscreen); #ref cont 1
   $ref = \@skipper; #ref count 2

   &sp();
   print "\@skipper : @skipper\n";
   print "$ref->[2]\n"; #result is jacket
   &sp();
}
=pod
这些一直存在，直到我们销毁了最后指向这些数据的引用
$ref = undef;
=cut

print "$ref->[2]\n"; #result still is jacket  #ref count 1
#@skipper变量被销毁,但是数据仍然可以访问,是因这数据在内存中,这些元素存在一个匿名数组中
push @$ref,'newtest';
print "\$ref : @$ref\n";


=pod
 引用计数和嵌套数据结构
=cut

#想象一下中间变量是所有子例子程一部分

my @all_names;
sub initialize_provisions_list
{
   my @Skipper=qw(blue_shirt hat jacket preserver sunsreen);
   my @Skipper_name=("Skipper",\@Skipper);

   my @Professor=qw(sunscreen water_bottle slide_rule batteries radio);
   my @Professor_name=('Professor',\@Professor);

   my @Gilligan=qw(red_shirt hat lucky_socks water_bottle);
   my @Gilligan_name=('Gilligan',\@Gilligan);

   @all_names=(  #set globle
                 \@Skipper_name,
                 \@Professor_name,
                 \@Gilligan_name
   );

}

&initialize_provisions_list();

#//设定@all_names数组包含了三个引用.在该子例程内部,先将命名数组引用放入其他命名数组中.最终，所有值都
#//放置于全局数组@all_names中.然而,一旦子例程返回,6个数组将被销毁，因为每个数组有另一个指向它们的引用，
#//所以将引用计数临时设置为2,但是当数组名称销毁之后,引用计数将变为1。因为计数不为零,所以该数据将继续
#//存在，尽管它现在只是被@all_names数组的元素所引用。


#与其对全局变量赋值,还不如按照下列方式不用@all_names数组重写代码,并且直接返回列表:
my @all_names2;
sub initialize_provisions_list2
{
   my @Skipper=qw(blue_shirt hat jacket preserver sunsreen);
   my @Skipper_name=("Skipper",\@Skipper);

   my @Professor=qw(sunscreen water_bottle slide_rule batteries radio);
   my @Professor_name=('Professor',\@Professor);

   my @Gilligan=qw(red_shirt hat lucky_socks water_bottle);
   my @Gilligan_name=('Gilligan',\@Gilligan);

   return (  
             \@Skipper_name,
             \@Professor_name,
             \@Gilligan_name
   );

}
@all_names2 = &initialize_provisions_list2();

=pod
  删除数据顶端的节点通常意味着删除该数据树包含的所有数据。例外情况是当对嵌套数据的引用添加额外
的副本时，数据就不会丢失。例如下面的,如果复制Gilligan的供应列表:
=cut

my $gilligan_stuff = $all_names2[2][1];
@all_names2 = undef;
print "@$gilligan_stuff\n";

&sp();

sub sp
{
   print '-' x 80,">\n";
}


=pod
 直接创建匿名数组
=cut

#临时语句块
my @skipper_with_names;
{
   my @skipper=qw(blue_shirt hat jacket preserver sunscreen);
   @skipper_with_names=('The Skipper',\@skipper);
}

#直接使用匿名数组构造函数
my $ref_to_skipper_provisions= [qw(blue_shirt hat jacket preserver sunscreen)];
#访问数组元素
print "@$ref_to_skipper_provisions\n";
&sp();


my $ref_new_skipper;
{
  my @temporay_name=(qw(blue_shirt hat jacket preserver sunscreen));
  $ref_new_skipper=\@temporay_name;
}


#构建更大的列表
my $ref_new_test = [qw(blue_shirt hat jacket preserver sunscreen)];
my @new_skipper_name = ('The skipper',$ref_new_test);
print "$new_skipper_name[1]->[0]\n";
print "@{$new_skipper_name[1]}\n";
&sp();

#代码重构
my @skipper_new=(
   'The Skipper',
    [qw(blue_shirt hat jacket preserver sunscreen)]
);


#在列表中嵌套
sub get_list
{
  return (
  ['The Skipper',[qw(blue_shirt hat jacket preserver sunscreen)]],
  ['The Professor',[qw(sunscreen water_bottle slide_rule batteries radio)]],
  ['The Gilligan',[qw(red_shirt hat lucky_sockes water_bottle)]],
  );
}

my @new_list=\&get_list();
print "@{@{${$new_list[0]}}[1]}\n";
&sp();

=pod
  创建匿名散例
=cut


my %gilligan_name=(
    name     => 'Gilligan',
    hat      => 'White',
    shirt    => 'Red',
    postion  => 'First Mate',

   );

my %skipper_name=(
    name     => 'Skipper',
    hat      => 'Black',
    shirt    => 'Blue',
    postion  => 'Captain',

   );

my  @crew_name=(\%gilligan_name,\%skipper_name);


foreach my $value (@crew_name)
{
   print "====> $value\n";
   foreach my $key (sort keys %{$value})
   {
        print "$key ${$value}{$key}\n";
   }
}

&sp();
#使用匿名构造函数直接构造引用，而匿名散例构造函数也是大括号的另一层含义

my $ref_to_gilligan;
{
   my %gilligan_info=(
      name       => 'Gilligan',
      hat        => 'White',
      shirt      => 'Red',
      postion    => 'First Mate',
      );
      $ref_to_gilligan=\%gilligan_info;
}

#单个步骤
my $gilligan_new_info={
      name       => 'Gilligan',
      hat        => 'White',
      shirt      => 'Red',
      postion    => 'First Mate',
   };


my $skipper_new_info={
      name       => 'Skipper',
      hat        => 'Black',
      shirt      => 'Blue',
      postion    => 'Caption',
   };

my @new_crew_name=($gilligan_new_info,$skipper_new_info);

foreach my $arrary (@new_crew_name)
{
   print "=====> $arrary\n";
   foreach my $key (sort keys %{$arrary})
   {
       print "$key => ${$arrary}{$key}\n";
   }
}
&sp();


#避免临时变量
my @new_arrary=(
   {
      name       => 'Skipper',
      hat        => 'Black',
      shirt      => 'Blue',
      postion    => 'Caption',
   },
   {
      name       => 'Gilligan',
      hat        => 'White',
      shirt      => 'Red',
      postion    => 'First Mate',
   },
 );

foreach my $value (@new_arrary)
{
   print "=======> $value\n";
   foreach my $key (sort keys %{$value})
   {
       print "$key =>", $value->{$key},"\n";
   }
}
&sp();


=pod
   自动带入

从文件读取数据,下面是数据格式

The Skipper
  blue_shirt
  hat
  preserver
  sunscreen
Professor
  sunscreen
  water_bottle
  slide_rule
Gillgian
  red_shirt
  hat
  lucky_sockes
  water_bottle
=cut

my %provisions;
my $person;
open(FL,'<','./data') or die "Cant open './data':$!\n";
while(<FL>)
{
  if(/^(\S.*)/)
  {
    #a person's name (no leading whitspace)
    $person=$1;
    $provisions{$person}=[] unless $provisions{$person};
  }elsif(/^\s+(\S.*)/)
  {
    die "No persopn" unless defined $person;
    push @{$provisions{$person}},$1;

  }else
  {
    die "I don't unerstand:$_\n";
  }
}

=pod
  上述代码的结构

my %provisions=(
    'The Skipper'    => [qw(blue_shirt hat preserver sunscreen)],
    'Professor'      => [qw(sunscreen water_bottle slide_rule)],
    'Gilligan'       => [qw(red_shirt hat lucky_sockes water_bottle)]
   );
=cut

#修改或增加值
push @{$provisions{'The Skipper'}},"test";

#增加一key and vlaue
push @{$provisions{'new'}},qw(test1 test2 test3 test4);

#对上述解引用
foreach my $key (sort keys %provisions)
{
    print "====> $key\n";
    foreach my $val (@{$provisions{$key}})
    {
        print "$val ";
    }
    print "\n";
}
&sp();


=pod
  自动带入和散列

src file:
professor.hut gilligan.crew 1250
professor.hut love.howell.hut 910
thurston.howell.ut lovey.howell.hut 1250
professor.hut lovey.howell.hut 450
ginger.girl.hut laser3.copyroom.hut 1218
ginger.girl.hut maryann.girl.hut 99
=cut

my %total_bytes;
open(DFL,'<','./data1') or die "Cannt open file './data1':$!\n";
while(<DFL>)
{
   my ($source,$destionation,$bytes)=split;
   $total_bytes{$source}{$destionation} +=$bytes;  
}

=pod
 上述代码数据结构(hash键是唯一的)：
%total_bytes=(
  'professor.hut' =>{i
       'gilligan.crew'    => '1250',
       'love.howell.hut'  => '910',
       'lovey.howell.hut' => '450',
    }, 
   'thurston.howell.ut' => {
       'lovey.howell.hut' => '1250',
    },
   'ginger.girl.hut'    => {
       'laser3.copyroom.hut'  => '1218',
       'maryann.girl.hut'     => '99',
    },
)
=cut

#hash嵌套数据解引用
foreach my $key1 (sort keys %total_bytes)
{
   print "key1 =====> $key1\n";
   foreach my $key2 (sort keys %{$total_bytes{$key1}})
   {
      print "$key2 => $total_bytes{$key1}{$key2}\n";
   }
}
&sp();