Intermediate perl 笔记

object:scalars,arrays,hashes

operate:grep,map,sort,print

 

 

@results=grep EXPR,@input_list;=========EXPR可以是 $_>10，也可以是/4$/

 

my @odd_digit_sum=grep digit_sum_is_odd($_),@input_numbers;
sub digit_sum_is_odd {
             my $input=shift;
             my igits=split //,$inupt;
             my $sum;
             $sum =$_ for @digits;
             return $sum % 2;
     }

 

eval  1 ====>trap eroors

example:

         

eval {$average=$total/$count};
print "error:$@" if $@;

eval  2 ======>calculate EXPR;

example:

eval '$sum = 2   2';
print "The sum is $sum\n";

         

#!/usr/bin/perl
my @outarray=qw(teacher mother father grandpa doctor sisiter telephone);
sub truth {
        print "@_\n";
        @input=shift;
        @inarray=qw(lunar final mother telephone tonado);
        for $i (@inarray) {
                if (grep $i eq $_,@_) {     ####### @_presents all arguments
                                print "$i is the same word\n";
                }

        }
}
&truth('gil',@outarray);

array reference/dereference

reference:
$array=\@array1
print @array1;
print $array1[1];

dereference:
print @{$array};
print ${$array}[1];

Example quote reference:

#!/usr/bin/perl
my @outarray=qw(teacher mother father grandpa doctor sisiter telephone);
my $file=\@outarray;
sub truth {
    @inarray=qw(lunar final mother telephone tonado);
    for $i (@inarray) {
        if (grep $i eq $_,@{$file}) {
                print "$i is the same word\n";
        }

    }
}
&truth('gil',@outarray);

######Print the reref reref of the array

#!/usr/bin/perl
sub initial {
my @outarray=qw(teacher mother father grandpa doctor sisiter telephone);
my @skip_outarray=('skip',\@outarray);
my @array=(\@outarray,
           \@skip_outarray,
          );
print "\@array==========@array\n";
print "\@array[0]=======@array[0]\n";
print "\@array[1]=======@array[1]\n";
print "\@\{\$array[0]\}=======@{$array[0]}\n";
print "\@\{\$array[1]\}=======@{$array[1]}\n";
print "\@{\${\$array[1]}[1]}========@{${$array[1]}[1]}\n";

           }
initial();

 ########Simplfy

#!/usr/bin/perl
sub initial {
my @outarray=qw(teacher mother father grandpa doctor sisiter telephone);
my @skip_outarray=('skip',\@outarray);
return (\@outarray,
           \@skip_outarray,
          );
}
my @all=initial();
print "\@all====@all\n";
print "\@all==========@all\n";
print "\@all[0]=======@all[0]\n";
print "\@all[1]=======@all[1]\n";
print "\@\{\$all[0]\}=======@{$all[0]}\n";
print "\@\{\$all[1]\}=======@{$all[1]}\n";
print "\@{\${\$all[1]}[1]}========@{${$all[1]}[1]}\n";

####create temporary variable

#!/usr/bin/perl
my $data1;
{
        my @temp=qw( one two three);
        $data1=\@temp;
}
print "\@temp====@temp\n";   ####@temp went away
print "\$data1======$data1\n";
print "\@\$data1======@$data1\n";

##########above mentioned example is same with the next:

#!/usr/bin/perl
my $array=[qw( one two three)];
print "\@\$array=======@$array\n";

#####grep expr

#!/usr/bin/perl
my @input_numbers=qw(1 2 4 7 8 16 32 64);   ########qw 中不能加逗号
my @indices_of_odd_digit_sums=grep {
        my $number=$input_numbers[$_];
        my $sum;
        for (split //,$number) {           ##########数字拆分为数组
        $sum =$_;                          ###########数字累加
}
        $sum%2;                            ############余数为1
} 0..$#input_numbers;
print "@indices_of_odd_digit_sums\n";
my @odd_digit_sums=@input_numbers[@indices_of_odd_digit_sums];############指定顺序号的数字
print "@odd_digit_sums\n";

#########use module retrieve

#!/usr/bin/perl
use Storable;
use Data::Dumper;
my @data1=qw(one won);
my @data2=qw(two too to);
push @data2,\@data1;
push @data1,\@data2;
store [\@data2,\@data1], 'some_file';
my $result=retrieve 'some_file';
print Dumper($result);

#########use package
#!/usr/bin/perl
{package Animal;
        sub speak{
                my $class=shift;
                print "a $class goes",$class->sound,"!\n";
        }
}
{package Cow;
        @ISA=qw(Animal);           =========>把cow看作Animal的一个子包
        sub sound {"moooooo"};
}
{package dog;
        @ISA=qw(Animal);           =========>why @ISA can't print
        sub sound {"wangwang"};
}
Cow->speak;
dog->speak;

############Accessing the Instance Data

#!/usr/bin/perl
{package Horse;
        @ISA=qw(Animal);
        sub sound {'neigh'};
        sub name {
                my $self=shift;
                $$self;                    =====>self rereference
        }
}
my $she='Mr.King';
my $who=\$she;
my $tv_horse=bless $who,'Horse';
print $tv_horse->name,"\n";


####################debug value
#!/usr/bin/perl
{package Animal;
    sub speak {
        my $class=shift;
        print "$class goes",$class->sound,"\n"
    }
    sub name {
            my $self=shift;
            $$self;
    }
    sub named {
        my $class=shift;
        my $name=shift;
        bless \$name,$class;
    }
}
{package Horse;
        @ISA=qw(Animal);
        sub sound {'neigh'}
}
my $tv_horse=Horse->named('Mr.Ed');
$tv_horse->speak;                    =============>a Horse=SCALAR(0x...) goes neigh





#########Add parameters to a method


#!/usr/bin/perl
{package Animal;
    sub named {
            my $class=shift;
            my $name=shift;
            bless \$name,$class;
#            print "\$class=====$class====\n";
    }
    sub name {
            my $either=shift;
            ref $either
                    ?    $$either #it's an instance,return name
                    :    "an unamed $either";#it's a class
            }
    sub speak {
            my $either=shift;
            print $either->name,'goes',$either->sound,"\n";
            }
    sub eat {
            my $either=shift;
            my $food=shift;
            print $either->name,"eats $food.\n";
    }
}
{package Horse;
        @ISA=qw(Animal);
        sub sound{'neigh'}
}
{package sheep;
        @ISA=qw(Animal);
        sub sound{'miemie'};
    }
my $tv_horse=Horse->named('Mr.Ed');
$tv_horse->eat('hay');
#Animal::eat($tv_horse,'hay');     ==============>same with the last line
sheep->eat('grass');




#########bless 人变狗
########<>
#!/usr/bin/perl
 use strict;
 use person;
 use dog;
 sub main()
 {
         my $object = {"name" => "tom"};
         # 先把"tom"变为人
         bless($object, "person");
         $object->sleep();
         $object->study();
         # 再把"tom"变为狗
         bless($object, "dog");
         $object->sleep();
         $object->bark();
         # 最后，再把"tom"变回人
         bless($object, "person");
         $object->sleep();
         $object->study();
 }
&main;

##########<>
 #!/usr/bin/perl -w
 package person;
 use strict;
 sub sleep() {
         my ($self) = @_;
         my $name = $self->{"name"};
         print("$name is person, he is sleeping\n");
 }
 sub study() {
         my ($self) = @_;
         my $name = $self->{"name"};
         print("$name is person, he is studying\n");
 }
 return 1;
#############<>
 #!/usr/bin/perl -w
package dog;
 use strict;
 sub sleep() {
         my ($self) = @_;
         my $name = $self->{"name"};
         print("$name is dog, he is sleeping\n");
 }
 sub bark() {
         my ($self) = @_;
         my $name = $self->{"name"};
         print("$name is dog, he is barking\n");
 }
 return 1;

###############<>

#!/usr/bin/perl
{package Animal;
    sub speak {
        my $class=shift;
        print $class->name," goes ",$class->sound,"\n";
    }
    sub name{
                my $self=shift;
                ref $self
                ? $$self
                : $self;
        }
    sub named {
                my $class=shift;
                my $name=shift;
                bless \$name,$class;
    }
    sub DESTROY{
            my $self=shift;
            print '[',$self->name,"has died.]\n";
    }
    sub eat {
            my $class=shift;
            my $food=shift;
            print $class->name," eat","  $food\n";
    }
}
{package Cow;
        @ISA=qw(Animal);
        sub sound{'neigh'};
       
}

sub feed_a_cow_named {
        my $name=shift;
        my $cow=Cow->named($name);
        $cow->eat('grass');
        print "Returning from the subroutine.\n";
}
print "Start of program.\n";
my $outer_cow=Cow->named('Bessie');
print "Now have a cow named",$outer_cow->name,"\n";
feed_a_cow_named('Gwen');
print "Returned from subroutine.\n";




###############Destroy Barn1
#!/usr/bin/perl
{package Animal;
    sub speak {
        my $class=shift;
        print $class->name," goes ",$class->sound,"\n";
    }
    sub name{
                my $self=shift;
                ref $self
                ? $$self
                : $self;
        }
    sub named {
                my $class=shift;
                my $name=shift;
                bless \$name,$class;
    }
    sub DESTROY{
            my $self=shift;
            print '[',$self->name," has died.]\n";
    }
    sub eat {
            my $class=shift;
            my $food=shift;
            print $class->name," eat","  $food\n";
    }
}
{package Cow;
        @ISA=qw(Animal);
        sub sound{'neigh'};
       
}

sub feed_a_cow_named {
        my $name=shift;
        my $cow=Cow->named($name);
        $cow->eat('grass');
        print "Returning from the subroutine.\n";
}
{package Barn;
        sub new {bless [],shift};
        sub add {push @{ shift},shift};
        sub contents {@{ shift}};
        sub DESTROY {
                my $self=shift;
                print "$self->nameaa is being destroyed\n";
                for ($self->contents){
                        print ' ',$_->name," goes homeless.\n";
                }
        }
}
my $barn=Barn->new;
$barn->add(Cow->named('Bessie'));
$barn->add(Cow->named('Gwen'));
print "Burn the barn:\n";
$barn=undef;
print "End of program.\n";

#############Destroy Barn 2#########################3