#!/usr/bin/perl use 5.010 use warnings # std out print "hello world\n"; # variable interpolation $meal="steak"; $barney="fred ate a $meal"; $barney='fred ate a '.$meal; # std in $line=<STDIN>; # chomp chomp($line=<STDIN>); chomp(@lines=<STDIN>); # defined $madonna=<STDIN>; if (defined($madonna)) { print "the input is $madonna"; } # array $fred[0]="abc"; $fred[1]="edf"; $fred[99]="ijk"; $fred[$#fred].="mn"; $fred[-1]=="ijkmn"; # true # list qw(fred barney betty wilma); qw! yahoo\! google ask msn !; # we can also use any other delimiter # list assign ($fred, $barney)=qw(flintstone rubble slate granite); # ignore slate and granite ($wilma,$dino)=qw[filntstore]; # $dino will be undef @rocks=qw(bedrock slate lava); # assign to whole list @stuff=(@rocks,@rocks); # push and pop: set or get at the tail of the array @array=5..9; $fred=pop(@array); # $fred is 9 and @array is (5,6,7,8) push(@array,0) # @array is (5,6,7,8,0) @others=qw/ 9 8 7 8 /; push @array @others # @array now get 4 new member # shift and unshift: set or get the head of the array @array=qw/ dino fred barney /; $m=shift(@array) # $m is dino and @array is ("fred" "barney") unshift(@array,"dino") # now @array is ("dino" "fred" "barney") # splice target_list start_index splice_length replaced_with @array=qw(pepples dino fred barney betty) 1-@removed=splice @array,2 # now @removed is qw(fred barney betty) and @array is qw(pepples dino) 2-@removed=splice @array,1,2 # now @removed is qw(dino fred) and @array is qw(pepples barney betty) 3-@removed=splice @array,1,2,qw(wilma) # replace dino and fred in array with wilma # interpolate list $rocks=qw(flintstone slate rubble) print "quartz @rocks limestone\n"; print "this is $rocks[2]\n"; print "littlepretty881203\@yahoo.com"; # yahoo is not a list # foreach 1-foreach $rock (qw/ bedrock slate lava/){ print "one rock is $rock.\n"; } 2-@rocks=qw/bedrock slate lava/; foreach $rock (@rocks){ $rock="\t$rock"; } # default variable $_ foreach (1..10){ print "count to $_\n"; } # reverse @fred=6..10 @fred=reverse @fred # sort: according to char code order @rocks=qw/ bedrock slate rubble granite/ @rocks=sort @rocks # subprograme: call with & sub sum{ $fred+$barney; } sub larger { if ($fred>$barney) { $fred; }else{ $barney; } } $fred=1; $barney=10; wilma=∑ # argument of subprogram: @_ list sub max { if ($_[0]>$_[1]) { $_[0]; }else{ $_[1]; } } $n=&max(10,15); # lexical variable or private variable: my sub max { # check number of arguments if (@_!=2) { print "Warning! &max should get exactly two arguments\n"; } my($m,$n)=@_; if ($m>$n) { $m; }else
$n; } # improved &max that take as many arguments as you give sub max { my($max_so_far) = shift @_; foreach(@_){ if ($_>$max_so_far) { $max_so_far=$_; } } $max_so_far; } # return sub which_element_is { my($what, @array)=@_; foreach (0..$#array){ if ($what eq $array[$_]) { return $_; } } -1; } my @names=qw/ fred barney betty dino wilma/; my $result=&which_element_is("dino",@names); # permanent variable: keep variable's value between subprograme's call sub running_sum { state $sum=0; state @numbers; foreach my $number (@_){ push @numbers,$number; $sum+=$number; } say "the sum of (@numbers) is $sum"; } running_sum(5,6) # the sum of (5,6) is 11 running_sum(1..3) # the sum of (5,6,1,2,3) is 17 running_sum(4) # the sum of (5,6,1,2,3,4) is 21 # input and output # STDIN while (defined($_=<STDIN>)) { print "I saw $_"; } # diamond sign while (defined($line=<>)) { chomp(line); print "It was $line that I saw\n"; } # call parameter @ARGV # format STDOUT printf "hello, %s: your password expires in %d days!\n",$user,$days_to_die; # print array my @items=qw(wilma dino pepples); my $format="the items are: ". ("%10s\n"*@items) # copy %10s @itmes times printf $format, @items; # open file handler open CONFIG, '<:encoding(UTF-8)', 'dino'; # use file dino as input stream open BEDROCK '>:encoding(UTF-8)', $fred; # use file $fred as output sream, refresh open LOG, '>>:encoding(UTF-8)', &get_logfile_name(); # use file logfile as output, append # use file handler # close file handler close CONFIG; # die if (!open LOG,'>>',logfile) { die "cannot create logfile: $!"; # $! error explaination } # or use autodie # another printf: say my @array=qw(a b c d) say "@array"; # scalar variable file handle open my $rocks_fh,'<','rocks.txt' or die "could not open rocks.txt: $!\n"; while (<$rocks_fh>) { chomp($_); ... } # hash: $hash_name{'key_name'}=value; $family_name{'fred'}='flintstone'; $family_name{'barney'}='rubble'; # access hash %some_hash=('foo',35,'bar',12.4,2.5,'hello'); @array=%some_hash; # unwinding hash's keys and values into an array # reverse hash: exchange keys and values my %inverse_hash=reverse %any_hash # easy way to define a hash my %last_name=( fred=>'flintstone', dino=>undef, barney=>'rubble', betty=>'rubble', ); # hash functions my %hash=('a'=>1,'b'=>2,'c'=>3); my @k=keys %hash; my @v=values %hash; my $count=keys %hash; #number of keys in hash # each: return the pair of key and value while (($key, $value)=each %hash) { print "$key => $value"; } # process hash in key's order foreach $key (sort keys %hash) { $value=$hash{$key}; print "$key => $value"; } # exists: if exist some key if (exists $book{"dino"}) { ... } # delete the key and the value delete $books{$person}; # %ENV hash print "PATH is $ENV{PATH}\n"; # Regular expression: pattern # simple pattern: included with '/' and '/' $_="yabba dabba doo"; if (/abba/) { # will use $_ as default match argument print "Matched."; } # Unicode properties if (/p{Space}) { # if the character is whitespace } if (/p{Digit}) { # if the string has a digit } if (/P{Space}) { # if the character is NOT whitespace } # metacharacter . will match any a character # * will match 0 or more than 0 # any old junk: .*, which match any characters any times # + will match 1 or more than once # ? will match 1 or 0 # () will grouped serval characters # | will match if either side matches # [] create character set # \d: digit set # \s=[\f\t\n\r] # \h: horizonal whitespace, \v: vertical whitespace # \R: match \r \n in DOS or Unix # [^\d]=\D, Caption means not