Perl practice code
Perl practice code 【评论】 【返回】






本文作者:Evel
阅读次数:2655
发布日期:2013-04-25
 
简单Tk模块使用

CODE:

#!/usr/bin/perl

#use warnings;
#use strict;
use Tk;
my ($main, $button,$label,%test,$button_data);

$main = MainWindow->new(
        -title=>"Get the hot list" ,
        -width=>200,
        -height=>100,
        #-Label(-text => 'Check on the new item'),
);

$button_data = $main->Button(
                -command => sub,
                #-default => disable,
                #-width=>50,
                -state => normal,
                #-height=>2,
                #-overrelief=> "",
                -text => "Click and Get data",
                -activebackground=>"blue",
                -activeforeground=>"red",
                -highlightbackground=>"yellow",
            )->pack;
$button_data->pack(-side=>'top',-padx=>5);

$color_name = $button_data->cget('-activebackground');
print "The buttone color is $color_name\n";

@con_list =


$button = $main->Button(
                -command => sub,
                #-default => disable,
                -width=>50,
                -state => normal,
                -height=>2,
                #-overrelief=> "",
                -text => "Exit",
                -highlightcolor=>"blue",
                                        
            )->pack;
$button->pack(-side=>'bottom',-padx=>5);

MainLoop();

sub get_data
{
    
    print "Check on the wedside now!\n";
}

sub exit_tool
{
    print "User exit the tool!\n";
    exit();
}



简单Win32::GUI模块使用

CODE:

#!/usr/bin/perl
use Win32::GUI;
#use Win32::GUI::Menu;

    $win = Win32::GUI::Window->new(
        -name=>'Evel',
        -width=> 400,
        -height=>100,
        -pos=>[200,100],
        -foreground=>'RED',
    );
    
    $win->AddLabel(
        -name => "label1",
        -text => "Label 1",
        -pos=>[100,50],
    );
     $win->AddButton(
        -name => "button1",
        -text => "Evel",
        -pos=>[50,50],
    );
    
$win->Show();
Win32::GUI::Dialog();

sub Main_Terminate {
        return(0);
    }



读取文件

CODE:

#! /usr/bin/perl
#use warnings;
use strict;
use Tk;
use Win32::OLE;
my $rfile = "F:\Perl\dump.pl";
my $wfile = "F:\Perl\wFile.txt";
my $fh;
my $fhw;
my @array1 = qw(3 4 5 6);         #only using ',' in the my @array1 = (3,4,5,6)
print "@array1\n";
print "$rfile\n";
print $wfile;
open($fh, "<$rfile");
#open($fhw,">>$wFile");
my $onerowcontent = <$fh>;        # only read one line,because the content is not array and file has multi row
my @allcontent = <$fh>;         # output all the content by using the array.
#print $onerowcontent;         #only first line will be print;
#print @allcontent;            # can output the content, but always using the foreach to contine handle on etch line;

my $line;
foreach $line (@allcontent){
     # chomp($line);         #remove all the <br> at the end of the line
     print $line;
    # <fhw> = $line;
};
#print $fh;
#perldoc -f open



正则表达式读取网页信息

CODE:

#!/usr/bin/perl
use warnings;
use strict;
use LWP::Simple;
my( $result,$page,$bSaveFile,@page_content,$update_page,$temp_page);
$page = "http://www.eda365.com/forum.php?mod=guide&view=new";
$temp_page = "c:/temp/page.txt";
$update_page = "c:/temp/topic.txt";
$bSaveFile = getstore( $page, $temp_page );
die "Couldn't connect to webside!" unless defined $bSaveFile;

if ( -e "page.txt" ){
    print "File ready. begin check...\n";
    open FH, "<$temp_page" || die("can't open datafile: $!");
    open CH, ">$update_page" || die("can't open datafile: $!");
    @page_content = <FH>;
    
    foreach (@page_content){
        #print $_;
        if( $_=~/xst/){
            #print $_;
            $_ =~ /\" >(.+)<\/a>/;
            print CH "\n";
        }
    }
    close FH;
    close CH;
}
if( -e $update_page ){
    unlink $temp_page;
    print "the topic list file created successful!";
}



数字操作符

CODE:

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

my ($n1,$n2,$n3,$n4,$n5,$n6,$n7,$n8);

$n1 = 3.14_15 + 2.31;        # add
$n2 = 0.03_14_15_19_26e2-0.1;    # subtraction
$n3 = 3_14.15_19_26E-2*10;        # multiplication
$n3 = 3_14.15_19_26E-2/10;        # division
$n4 = 12/4;                # int division
$n5 = 10/3;                # float division result
$n6 = 10 % 3;                # modulus
$n7 = 10.9 % 3;            # remove the float firstly and then modulus.equal to 10/3
$n8 = 3**3;                # exponentiation

print "$n1\n";
print "$n2\n";
print "$n3\n";
print "$n4\n";
print "$n5\n";
print "$n6\n";
print "$n7\n";
print "$n8\n";



单引号双引号直接量

CODE:

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

my ($n1,$n2,$n3,$n4,$n5,$n6,$n7,$n8);

$n3 = "Good";

$n1 = 'I got a \n Apple';                    # all the single-quited string literal will not be analyzed
$n2 = "I got a \n Apple";                    # all the double-quited string literal will be analyzed.
$n4 = "I got a \n $n3 Apple";    

print "$n1\n";
print "$n2\n";
print "$n4\n";



单引号双引号直接量

CODE:

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

my ($n1,$n2,$n3,$n4,$n5,$n6,$n7,$n8);

$n3 = "Good";

$n1 = 'I got a \n Apple';                    # all the single-quited string literal will not be analyzed
$n2 = "I got a \n Apple";                    # all the double-quited string literal will be analyzed.
$n4 = "I got a \n $n3 Apple";    

print "$n1\n";
print "$n2\n";
print "$n4\n";



双引号内反斜杠的转义作用

CODE:

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

my ($n1,$n2,$n3,$n4,$n5,$n6,$n7,$n8);

$n3 = "Good";
$n4 = "BAD";

$n1 = "I got a \Uapple";                            # all the single-quited string literal will not be analyzed
$n2 = "I got a\t$n3\t\Uapple";                        # \t table tab spacing
$n5 = "I got a \l$n4\t\Uapple";                        # \l next one  letter change to lowercase
$n6 = "I got a \L$n4\t\Uapple";                        # \L next one to the end of the string change to all lowercase
$n7 = "I got a \L$n4\t\Uapple \Q&%*(#)@"; # All the non-word update to add one slash

print "$n1\n";
print "$n2\n";
print "$n5\n";
print "$n6\n";
print "$n7\n";



字符串操作符

CODE:


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

my ($n1,$n2,$n3,$n4,$n5,$n6,$n7,$n8);

$n1 = "Good";
$n2 = "BAD";
$n3 = "APPLE";

$n4 = "I got a ". $n1 . " $n3";        # using dot. to link all the string
$n5 = "I got a".' '.$n2.' '."$n3";        # using dot. with single quited and double to link string
$n6 = "$n1"x3;                # repeat the string 3 times.
$n7 = "$n2"x(2.4+2);                # caculate the repeat time firstly
$n8 = 5x(2.4+2);                # because left side of x must be string type, so here the 5 need update to string "5" fistly.

print "$n4\n";
print "$n5\n";
print "$n6\n";
print "$n7\n";
print "$n8\n";



数字与字符串之间的自动转换

CODE:


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

my ($n1,$n2,$n3,$n4,$n5,$n6,$n7,$n8);

$n1 = "10";
$n2 = "4";
$n4 = 5;
$n6 = "14test5";

$n3 = $n1 * $n2;    # auto change the two string to number, because the * operator type is only for number
$n5 = $n4 x 4;    # $n4x4 will get wrong, because Perl will check the whole '$n4x4' as one variable.
$n7 = $n6 x $n2;    # the string $n2 will change to number 4, repeat string $n6 4 times.
$n8 = $n6 * $n2;    # the '14test5' will be updated to number 14, $n2 udpate to 4, then get the result

print "$n3\n";
print "$n5\n";
print "$n7\n";
print "$n8\n";



内建Warning信息的显示与解释

CODE:


#!/usr/bin/perl  
use warnings;        # also can using "perl -w XX.pl" in DOS to report the warning information
#use strict;

use diagnostics;    # report the detail information on the running warning.
            # use 'perl -Mdiagnostics ttt.pl' at outside to check detail
my ($n1,$n2,$n3,$n4,$n5,$n6,$n7,$n8);
$n1 = "5";
$n2 = "14test5";
#Argument "14test5" isn't numeric in multiplication (*) at F:\Perl\ttt.pl line
# 18 (#1)
#(W numeric) The indicated string was fed as an argument to an operator
# that expected a numeric value instead.  If you're fortunate the message
# will identify which operator was so unfortunate.

$sRun = "Program has been running...";
$n3 = $n2 * $n1;    # the '14test5' will be updated to number 14, $n2 udpate to 5, then get the result

print "$sRun\n";
print "$n3\n";



标量变量的名称规范以及简单等号赋值

CODE:

#! /usr/bin/perl

use warnings;
use strict;

my ($Fred,$fred,$check_id,$CheckID,$ARGV,$check_value);

$Fred = "This is a variable";                    #the variable is case-sensitive;
$fred = "This is different variable"; ##the variable is case-sensitive;

$check_id = 2;            # the variable name should be meanful.
$CheckID = 3;                # this is a new style on the name of variable
$ARGV = "Check";        # the all uppercase always mean a special variable
$check_value = 4+3;    # calculate and then assigned to check_value
$check_value = $check_value *4; # now check_value is 28;

print "$check_id\n";
print "$CheckID\n";
print "$ARGV\n";
print "$check_value\n";



第二章习题

CODE:

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

my( $radio, $girth);

#$radio = 12.5;
#$girth = 2*3.14_15_92_654*$radio;
#print "Got the girth of the circle is $girth\n";

print "Please input the radio of the circle\n";
$radio =chomp <STDIN>;
if( $radio<0 )
{
    $girth = 0;
}
else
{
    $girth = 2*3.14_15_92_654*$radio;
}
print "Got the girth of the circle is $girth\n";

my( $num1,$num2,$result);

print "Please input first number\n";
$num1 = <STDIN>;
print "Please second number\n";
$num2 = <STDIN>;
$result = $num1*$num2;
print "Got the product is $result\n";



第四章习题

CODE:

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

my( @list,$result,$avg,@above,@BA );

@list = (1..10);
print "Test on the totle function\n";
@above = above_average( @list );
print @above;
#check which one bigger than average value
sub above_average{
    $result = total(@_);
    print "$result\n";
    #$avg = $result/($#list+1);            # array length use the $#array_name
    $avg = $result/@_;                # the @_ here feedback length of the array
    foreach (@_){
        if( $_ > $avg ){
            # print "$_ bigger than average value $avg\n";
            my @BA = push( @BA, $_);     # put all the $_ to the new array
        }
    }
    @BA;                        # feedback this array
}

# got the sumup value
sub total{
    my $sum;
    foreach (@_){
        $sum += $_ ;    
    }
    return $sum;
}



标量变量的双目运算符

CODE:

#! /usr/bin/perl

use warnings;
use strict;

my ($Fred,$fred,$check_id,$CheckID,$ARGV,$check_value);

$check_value = 5;
$check_value *= 4; # now check_value is 20; means $check_value = $check_value * 4

$fred = "Apple";   # fred value is Apple
$fred .= "Apple";  # fred value is AppleApple; connect the string together

$Fred = 3;                # Fred value is 3;
$Fred **= 3;            # Fred value is 3*3*3=27

print "$fred\n";
print "$Fred\n";



标量变量打印输出与内插

CODE:

#! /usr/bin/perl

use warnings;
use strict;

my ($Fred,$fred,$check_id,$CheckID,$ARGV,$check_value,$check_values);

$check_value = "test";
$check_values = "test-world";
print "print a word\n";
print 5*9;
print ".\n";

print "I", " Got ", " a ", " pad\n";                  # print function are handling a list

$fred = "I need check $check_value\n";              # use the double quotation marks to interpolation
$Fred = 'I need check '. $check_value. "\n"; # use the single quotation marks to interpolation
print $fred;                                                                 # fred and Fred is different, but using two ways to print the same value.
print $Fred;
print "now I need print $check_values now.\n";   # print the value of $check_values
print "now I need print $s now.\n"; # print the value of $check_value and add a s at the end of it.
print "$check_value\[]\n";    # [] and ',:: need using the nagtive-slash to annotation it firstly



操作符优先级
CODE:

#! /usr/bin/perl

use warnings;
use strict;

my ($v1,$v2,$v3,$v4);


$v1 = 2**1**3; # 2**(1**3),got the value of 1**3 =1, then caculate the 2**1= 2,from right to left
$v2 = 12/3/2;    #  (12/3)/2, got the value of 12/3=4, then caculate 4/2=2
$v3 = 36/6*3; # (36/6)*3, got the value of 36/6=6, then caculate 6*3 = 18
$v4 = 36/6&&3; # (36/6)&&3,got the calue of 36/6=6, then caculate 6&&3 = 3, from left to right

print "$v1\n";
print "$v2\n";
print "$v3\n";
print "$v4\n";



比较操作符与if-else逻辑

CODE:

#! /usr/bin/perl

use warnings;
use strict;

my ($v1,$v2,$v3,$v4);

$v1 = 3;
$v2 = 5;
$v3 = 'a';
$v4 = 'c';

# == eq
# != ne
# <  lt
# >  gt
# <= le
# >= ge

# for number compare, need using number sign fun to compare
if( $v1 > $v2){               
    print "v1 bigger than v2\n";
}
# if and else must using the {} to inclduing the code
else {                  
    print "v1 smaller than v2\n";
}

# for charactor compare, need using string fun to compare
if( $v3 eq $v4){                 
    print "v3 equal to v4\n";
}
else {
    print "v3 not equal to v4\n";
}



#Perl中的布尔值

CODE:

#! /usr/bin/perl

use warnings;
use strict;

my ($v1,$v2,$v3,$v4,$v5);

$v1 = 3;
$v2 = 0;
$v3 = '';
$v4 = 'c';
$v5 = '0';

# for number 0 is faulse, others is true
# for string,'' and '0' is faulse, other is true
# for others, undef is faulse, other is true

# for number compare, need using number sign fun to compare
if( $v1 ){               
    print "v1 is true\n";
}
# if and else must using the {} to inclduing the code
else {                  
    print "v1 is faulse\n";
}

# for charactor compare, need using string fun to compare
if( $v3 ){                 
    print "v3 is true\n";
}
else {
    print "v3 is faulse\n";
}

if( $v5 ){                 
    print "v5 is true\n";
}
else {
    print "v5 is faulse\n";
}



标准输入与chomp

CODE:

#! /usr/bin/perl

use warnings;
use strict;

my ($v1,$v2,$v3,$v4,$v5);

if( chomp( $v1 = <STDIN>)){
chomp $v1;    # chomp will modify to the variale self_value
$v2 = "test\nA new one\n";
print $v1;
# remove the last \n in v2
$v3 = chomp $v2;    
print $v2;
# if put the chopm result into the aviriable,
#the value is 1 if successful. return 0 if not successful.
print $v3;  
}




While 循环和undef值

CODE:

#! /usr/bin/perl

#use warnings; # ingore the warning information on the undef variable
use strict;

my ($v1,$v2,$v3,$v4,$v5);

$v1 = 0;
# the value of the $v1 will be check before runing the loop
while( $v1 < 10){
    $v1 += 2;
    print "print the even from 0 to 10:$v1\n";
}

#the value of the undef is set to number 0, so output is 0
$v3 = $v2 * 5;
print "v2 is not initial, number v3 now value is $v3 \n";

$v5 = $v2."test for undef";
print "v2 is not initial, string v5 now value is $v5 \n";

# $v2 = "haha";
# defined function checking on the variable value is undef or not
if(defined($v2)){
    print "v2 is initial and got the value\n"
}
else {
    print "v2 is not initail!\n"
}



列表和数组

CODE:

#! /usr/bin/perl

#use warnings;
use strict;

my ($v1,@a1,@new_array,$new_array);

#using the qw to replace the array list,
#@new_array = qw{AA BB CC};
@new_array = qw/AA BB CC/;
print "@new_array\n"; # print all the member of the array
print "$new_array[2]\n";  #visit the array member, it's a scalar, so need befin by $
#( "AA" "BB" "CC" ) data_value
#   0    1    2     ID
$new_array = "scalar"; # scalar variable,different with the array
$new_array[0] = "EE";     # visit and update on of the array member value
$new_array[1] = "BB";
$new_array[2] = "CC";
$new_array[10] = "ZZ"; # now array update to length is 11

print "@new_array\n";
print "$#new_array\n";

print "$new_array[1.5]\n"; #1.5-->1
print "$new_array[-1.5]\n"; #-1.5->-1,means read array data from bottom to top
print "$new_array[5]\n";  # if id value is not assigned, the value is undef
print $new_array[254]+2; # if id value extend the scrop, value is undef, here the value is 0
print "$new_array[$#new_array]\n"; # using $#array_name to get the last ID value of the array

@new_array = ( "AA", "BB", "CC" );
#after reassign, the array length is updated to 3
print "@new_array\n";
print "$#new_array\n";



列表赋值与qw操作

CODE:

#!perl

#use warnings;
use strict;

my ($v1,$v2,$v3,$v4,$v5,$v6);

($v1,$v2,$v3) = ("AA","BB","CC","DD",);
print "$v3\n";  # v3 = CC, the DD will be ignore, and the comma will be ignored also
($v4,$v5,$v6) = (1..3);
print "$v5\n";  #v5 is 2
#using the qw to replace the double quotation marks, the 5 will be ignored
($v1,$v2,$v3,$v4) = qw[1 2 3 4 5];
print "$v4\n";
($v1,$v2,$v3,$v4) = qw/1 2 3/;
# v4 is set to undef
print "$v4\n";

 
Processed in 0.134807 second(s)