PERL-RECORD

“此处”文档
有一种面向行的引号包围是以 Unix shell 的“此处文档”语法为基础的。说它面向行是因为它的分隔符是行而不是字符。

起始分隔符是当前行，结束分隔符是一个包含你声明的字串的行。你所声明的用以结束引号包围的内容之字串跟在一个 << 后面，所有当前行到结束行（不包括）之间的行都是字串的内容。结束字串可以是一个标识符（一个单词）或者某些引号包围的文本。如果它也被引号包围，包围的类型决定文本的变换，就象普通的引号包围一样。没有包围的标识符当作用双引号包围对待。反斜杠逃逸的标识符当作用单引号包围（为与 shell 语法兼容）。在 << 和未包围的标识符之间不能有空白，不过如果你用一个带引号的字串做标识符，则可以有空白（如果你插入了空白，它会被当作一个空标识符，这样做是允许的但我们不赞成这么用，它会和第一个空白行匹配——参阅下面第一个 Hurrah! 例子。）。

结束字串必须在终止行独立出现——不带引号以及两边没有多余的空白。（译注：常见的错误是为了美观在结束字串前面加 \t 之类的空白，结果却导致错误．）

  print <  The price is $Price.
  EOF
  print <<"EOF";   # 和上面一样，明确的引号包围
  The price is $Price.
  EOF
  print <<'EOF';   # 单引号包围
  （略）
  EOF
  print << x 10;   # 打印下面行10次
  The Camels are coming! Hurrah! Hurrah!
  print <<"" x 10;   # 实现上面内容的比较好的方法
  The Camels are coming! Hurrah! Hurrah!
  print <<`EOC`;   # 执行命令
  echo hi there
  echo lo there
  EOC
  print <<"dromedary", <<"camelid";   # 你可以堆叠
  I said bactrian.
  dromedary
  She said llama.
  camelid
  funkshun(<<"THIS",23,<<'THAT');   # 在不在圆括弧里无所谓
  Here's a line
  ro two.
  THIS
  And here's another.
  THAT
不过别忘记在最后放分号以结束语句，因为 Perl 不知道你不是做这样的试验：

  print <<'odd'
  2345
  odd
     +10000;   #打印12345
如果你的此处文档在你的其他代码里是缩进的，你就得手工从每行删除开头的空白：

  ($quote = <<'QUOTE') =~ s/^\s+//gm;
     The Road goes ever on and on,
     down from the door where it began.
  QUOTE
你甚至还可以用类似下面的方法用一个此处文档的行填充一个数组：

@sauces = <

  normal tomato
  spicy tomato
  green chile
  pesto
  white wine
End_Lines

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
标量环境与数组环境的区别
      ","的意义

我们早先说过在语法描述里的 LIST 表示某个东西给它的参数提供了列表环境，不过只有列表文本自身会部分违反这条规则，就是说只有在列表和操作符全部处于列表环境里才会提供真正的列表环境。列表文本在列表环境里的内容只是顺序声明的参数值。作为一种表达式里的特殊的项，一个列表文本只是把一系列临时值压到 Perl 的堆栈里，当操作符需要的时候再从堆栈里弹出来。

不过，在标量环境里，列表文本并不真正表现得象一个列表（LIST），因为它并没有给它的值提供列表环境。相反，它只是在标量环境里计算它的每个参数，并且返回最后一个元素的值。这是因为它实际上就是伪装的 C 逗号操作符，逗号操作符是一个双目操作符，它会丢弃左边的值并且返回右边的值。用我们前面讨论过的术语来说，逗号操作符的左边实际上提供了一个空环境。因为逗号操作符是左关联的，如果你有一系列逗号分隔的数值，那你总是得到最后一个数值，因为最后一个逗号会丢弃任何前面逗号生成的东西。因此，要比较这两种环境，列表赋值：

  @stuff = ( "one", "two", "three");
给数组@stuff，赋予了整个列表的值。但是标量赋值：

  $stuff = ( "one", "two", "three");
只是把值 "three" 赋予了变量 $stuff。和我们早先提到的 @files 数组一样，逗号操作符知道它是处于标量还是列表环境，并且根据相应环境选择其动作。

值得说明的一点是列表值和数组是不一样的。一个真正的数组变量还知道它的环境，处于列表环境时，它会象一个列表文本那样返回其内部列表。但是当处于标量环境时，它只返回数组长度。下面的东西给 $stuff 赋值 3：

  @stuff = ("one", "two", "three");
  $stuff = @stuff;

++++++++++++
#!/usr/bin/perl -w
sub openfile{

  open (F,$_[0]) ||die "could not open the file \n";

}
$f="a.txt";
while(1)
{   eval{
    openfile($f);
        };
    last unless $@;
  print " enter a file \n";
 chomp($f=<>);
}

++++++++++++
reverse sort 生成一个新数组
@arr1=reverse(@arry);将数据项反转  (cd,ab)
$arr1=reverse(@arry);将原子项反转dcba
@arr=("ab","cd");
$ss=reverse($str);
@a=sort {$a<=>$b @arr1}按数字升序进行比着
$scarar=join(":",@arry);  ab:cd
chomp  $\="\n";
@arr=(1,2,3)
@arr1=(53,34)
@arr(@arr1,1,2,3) #(53,34,1,2,3)因为%hash @arr都只存储标量
@ky=keys(%hash)
@val=valus(%hash);
while (($key,$value)=each %hash){}
+++++++++++++++++++++++++
引用定义:
 1. $str="abc" ;首先计算机内存分配一个空闲的内存地址(内存地址编号
  为 设 1 ,然后将值"abc"往地址为1 里填(存储"abc")
  $ref_str=\$str;表明是个引用,指用的是内存地址1;
  $$ref_str="change";
       $ref_str知道是个引用,计算机则查找内存地址(1),再将"change" instead
       "abc"  则$str的值也变为"change "
            

匿名引用:[]  {}
数组:[] $ref_arr=[1,2,3];
$ref_arr->[0] ###1  as  $$ref_arr[0]
hash:{} $ref_hash={apple=>1,orange=>2}
$ref-hash->{"apple"} ##1 as $$ref_hash{apple}
所以生成二维数组的方法:使用匿名数组引用如:
$arrary=([a,b,c],[e,f]);匿名数组引用 注意:既然匿名,就不用\([a,b,c],[e,f]) 加\了
$arrary[0][0]  as  $arrary->[0]-[0]  ##a

65 page
print <<"aoe";
  this is my life ,
        i should chose what kinds of job  satisfied with me .
aoe
++end++
result:
this is my life ,
        i should chose what kinds of job  satisfied with me .

+++++=关于GetOpts的研究:

++++++=读文件 上下文:
opent (FILE,"C:\\A.TXT");
@arr=此时文件的内容被计入到数组中,并且每行为数组的一个元素.
$arr= 此时文件的内容不全被放入$arr,它只会读入一行数据,此时我们可以利用while ($arr=)来读

#!/usr/bin/perl
             open (FILE,"             $con=0;
             while(!eof(FILE)){
              read(FILE,$con,1024,$off); read(文件句柄,标量,1024,起始位置) 字节最长是1024
              print $con;
              $off+=1024;
             }
      +++++++++++++++++++++
      seek(FIILE,57,0)   $TEL= tell  FILE
      ====================
       if(!( -e b.txt)){print "ha\n";   -e b.txt 不加""
               #rename("a.txt","b.txt");
             }

      use File::Copy;
             open (FILE,"             $con=0;
             while(!eof(FILE)){
              read(FILE,$con,1024,$off);
              print $con;
              $off+=1024;
             }

               #rename("a.txt","b.txt");
              copy("b.txt","b1.txt");
              copy("b.txt",\*STDOUT);

       ++++++++++++
       use File:Find   find(文件处理函数的引用,需要查找的目录列表[可以是一个目录,也可以是逗号隔开的一系列目录])
       find(\&wanted,"c:\\perllib","c:\\my\\lib");  # 获得c:\\perllib c:\\my\\lib下的文件名,并依次将文件名存入到$_中,
       sub wanted{
          if (/.html/){
       open FILE,"$File::Find::name";
       H:while($line=){
          if ($line=~/mail/)
   {
    print $File::Find::name."\n";
    last H;
   }
   close FILE;
        }

   }
      
       }
       +++++++++++

       flock(FILE, 1)    1共享锁定, 2独享,4 非锁定,8解锁
       上下文:
       $str="mxconfig mxnow";
       @arr=($str=~/mx/g); 每次匹配到的都存入@arr的一个元素;
       $scount=($str=~/mx/g);返回匹配成功的次数;
       (^|\s+)is[(\s+)\.,;!]
       +++++++++++
       .*的贪婪性
       $char='a is bthere not reason for me to get you b";
       $char=~m/a(.*)b/
       print $1; #结果$1为 is there not reason for me to get you  而我们需要尽量匹配到最少 is
              $char=~m/a(.*?)b/   is ---称为懒人匹配
       +++++++++++++++++++++++++++++
       如何来创建类:
       #!/usr/bin/perl

use strict;
package human;
sub new{
my $class=shift;    # 提取类名,对于类来说,第一个元素是类名@_
my %hash=@_;        # @_为传入的参数
my $self={};    #此两行使到类有一个共享引用变量,匿名HASH与类相关联.
bless $self, $class;  #1.推出classname,2.空HASH3,bless hash classname.
$self->{name}=$hash{name}||"xiao";
$self->{sex}=$hash{sex};
$self->{workday}=$hash{workday};
return $self;
}
sub rest{
 my $self=shift;       #此处的$self指向已经初始化的对像引用,也就是上面.
 sleep(2);
 print "$self->{name} 休息了2秒\n";
}
sub work{
  my $self=shift;
  $self->{workday}++;
  print "又工作了一天了$self->{workday}\n";
}
sub DESTROY{
 my $self=shift;
my %hash=%$self;
my $string="";
 foreach(keys %hash){
 $string.=$_."\t".$hash{$_}."\n";
 }
 open (FILE,">c:\\human.txt");
 print FILE "$string\n";
 close FILE;
}

1;
子类:#!/usr/bin/perl

use human;
package worker;
@ISA=qw(human);
sub worker{
  print "we are worker\n";

}
sub work {
   print "overload\n";
         my $self= shift;
   print $self->{name}."\n";
}
1;

+++++++调用
#!/usr/bin/perl

 #use human;
 use worker;
 my $hu=worker->new("name"=>"",sex=>"24",workday=>"100");
 $hu->rest();
 $hu->work();
 ++++++++++++++++++++++++
 #!/usr/bin/perl

use AnyDBM_File;          #use AnyDBM_File;
open(FILE,"dbmopen(%table,"human",0666);   #table connect dbmfile ,create dbm
while(){
 chomp;
 my ($name,$code)=split(/\s/,$_);
 $table{$name}=$code;   #give %table vars as give db vars
}
close FILE;
dbmclose %table;        #dbmclose %tables;
dbmopen(%show,"human",0666);             #open
 foreach my $key(keys %show){
  print $key." $show{$key}\n";
 }
# cosult
  #dbm 操作主要针对hash来操作;

  +++++++++++++++++++++++++
  #!/usr/bin/perl

use strict;
use AnyDBM_File;
my %data;
dbmopen(%data,"student",0666);
 viewdata(\%data);
while(1){
print"请输入你的选择(1,2,3)  1.add record 2.del  3.view   4.stop\n";

my $selected;
chomp($selected=);
($selected eq 1)&& adddata(\%data);
($selected eq 2)&& deldata(\%data);
($selected eq 3)&& viewdata(\%data);
($selected eq 4)&& stopdata(\%data);
}
sub adddata{
my ($data,$name,$code);
$data=shift;
print "\n studentname:";
chomp($name=);
print "\n the code:";
chomp($code=);
if(!defined($data->{$name})){
 addItem($data,$name,$code);
 }else{
   print "there is have record already!\n";
    print "\n doyou modified the code :";
    my $input ;
    chomp($input=);
    if ($input eq "Y"){
             addItem($data,$name,$code);
    }

 }
}
sub addItem{
 my ($data,$name,$code)=@_;
 $data=shift;
 $data->{$name}=$code;
}
sub  viewdata{
    my $data=shift;
    foreach my $key(keys %$data)
    {
      print $key." $data->{$key}\n";
    }
}
sub deldata{
    my  $data=shift;
        print "\n studentname:";
    my $name;
chomp($name=);
if (defined($data->{$name})){
   delete $data->{$name};
}else
 {
   print "there is not student of your chioce \n";

 }
}
sub stopdata{
  my $data=shift;
  dbmclose(%$data);
  exit 0;
}

++++++++++++
++++++++++++++
++++++++++++++++++
对/etc/protocols的操作.
#!/usr/bin/perl

setprotoent(1); #0,close;1,open
while (($name,$alias,$port)=getprotoent()){
 print "Name=$name,Alias=$alias,Port=$port\n";
}
endprotoent();

for(my $i=0;$i<256;$i++){
   my ($name,$alias,$port=getprotobynumber($i);
 print "Name=$name,Alias=$alias,Port=$port\n";
}
而对于系统提供的服务则有/etc/services;
setservent(1);
while (($name,$alias,$port)=getservent()){
 print "Name=$name,Alias=$alias,Port=$port\n";
}
endservent();
同理getservebynumber($i) getservebyname(tcp);

 

#!/usr/bin/perl

use DBI;

my $host="127.0.0.1";
my $db="xiaoone";
my $user="root";
my $pass="xiaoone";
my $dbh=DBI->connect("DBI:mysql:$db:$host",$user,$pass)||die "$!\n";
 #$dbh->do("create database xiaoone")||die "$!\n";
 $dbh->do("drop table if exists test")||die "$!\n";
$dbh->do("create table test (id int(4) not null auto_increment primary key, name char(30))")||die "$!\n";
for (my $i=1;$i<=10;$i++){
 $dbh->do("insert into test(name) values('xiaoone$i')")|| die "$!\n";
 }
 $SQL=$dbh->prepare("select *from test");
$SQL->execute();
 while((my $row=$SQL->fetchrow_arrayref)){
      print "#"x 5,$row->[0],"\$"x5,$row->[1],"\n";

 }
print "Content-type: text/html\n\n";
print "

Hello!

\n";