Perl Examples

hacklab

#!/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=&sum;
# 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